
 (* SWAPPING PASCAL COMPILER INCLUDE FILES *)
 (*$C COPYRIGHT (C) 1978 REGENTS UCSD I.5.A.1*)
	
 (*$T+*) (*$S+*)
	
 (* $I COMPGLBLS.TEXT*)
	
 (*$U-*)
	
 PROGRAM PASCALSYSTEM;  (* VERSION I.5 (Unit Compiler)  9-01-78 *)


 (************************************************)
 (*                                              *)
 (*        UCSD  PASCAL  COMPILER                *)
 (*                                              *)
 (*    BASED ON ZURICH P2 PORTABLE               *)
 (*    COMPILER, EXTENSIVLY                      *)
 (*    MODIFIED BY ROGER T. SUMNER               *)
 (*    SHAWN FANNING AND ALBERT A. HOFFMAN       *)
 (*    1976..1978                                *)
 (*                                              *)
 (*    RELEASE LEVEL: I.3 AUGUST, 1977           *)
 (*                   I.4 JANUARY, 1978          *)
 (*                   I.5 SEPTEMBER, 1978        *)
 (*                                              *)
 (*    INSTITUTE FOR INFORMATION SYSTEMS         *)
 (*    UC SAN DIEGO, LA JOLLA, CA 92093          *)
 (*                                              *)
 (*    KENNETH L. BOWLES, DIRECTOR               *)
 (*                                              *)
 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)
 (*                                              *)
 (************************************************)
	
	
 TYPE PHYLE = FILE;
 INFOREC = RECORD
             WORKSYM,WORKCODE: ^PHYLE;
             ERRSYM,ERRBLK,ERRNUM: INTEGER;
             SLOWTERM,STUPID: BOOLEAN;
             ALTMODE: CHAR
           END;


 SEGMENT PROCEDURE USERPROGRAM;

   SEGMENT PROCEDURE FILEHANDLER;
   BEGIN END;

   SEGMENT PROCEDURE DEBUGGER;
   BEGIN END;

   SEGMENT PROCEDURE PRINTERROR;
   BEGIN END;

   SEGMENT PROCEDURE INITIALIZE;
   BEGIN END;

   SEGMENT PROCEDURE GETCMD;
   BEGIN END;

   SEGMENT PROCEDURE NOTUSED1;
   BEGIN END;

   SEGMENT PROCEDURE NOTUSED2;
   BEGIN END;

   SEGMENT PROCEDURE NOTUSED3;
   BEGIN END;

 BEGIN END; (* USERPROGRAM *)

 SEGMENT PROCEDURE PASCALCOMPILER(VAR USERINFO: INFOREC);

 CONST DISPLIMIT = 12; MAXLEVEL = 8; MAXADDR = 28000;
       INTSIZE = 1; REALSIZE = 2; BITSPERWD = 16;
       CHARSIZE = 1; BOOLSIZE = 1; PTRSIZE = 1;
       FILESIZE = 300; NILFILESIZE = 40; BITSPERCHR = 8; CHRSPERWD = 2;
       STRINGSIZE = 0; STRGLGTH = 255; MAXINT = 32767; MAXDEC = 36;
       DEFSTRGLGTH = 80; LCAFTERMARKSTACK = 1; REFSPERBLK = 128;
       EOL = 13; MAXCURSOR = 1023; MAXCODE = 1299;
       MAXJTAB = 24; MAXSEG = 15; MAXPROCNUM = 149;

 TYPE
                  (*BASIC SYMBOLS, MUST MATCH ORDER IN IDSEARCH*)

      SYMBOL =  (IDENT,COMMA,COLON,SEMICOLON,LPARENT,RPARENT,DOSY,TOSY,
                 DOWNTOSY,ENDSY,UNTILSY,OFSY,THENSY,ELSESY,BECOMES,LBRACK,
                 RBRACK,ARROW,PERIOD,BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,
                 FORSY,WITHSY,GOTOSY,LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,
                 FUNCSY,PROGSY,FORWARDSY,INTCONST,REALCONST,STRINGCONST,
                 NOTSY,MULOP,ADDOP,RELOP,SETSY,PACKEDSY,ARRAYSY,RECORDSY,
                 FILESY,OTHERSY,LONGCONST,USESSY,UNITSY,INTERSY,IMPLESY,
                 EXTERNLSY,SEPARATSY);


      OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,
                  GEOP,GTOP,NEOP,EQOP,INOP,NOOP);

      SETOFSYS = SET OF SYMBOL;

      NONRESIDENT = (SEEK,FREADREAL,FWRITEREAL,FREADDEC,FWRITEDEC,DECOPS);
      NONRESPFLIST = ARRAY[NONRESIDENT] OF INTEGER;

                                               (*CONSTANTS*)
      CSTCLASS = (REEL,PSET,STRG,TRIX,LONG);
      CSP = ^ CONSTREC;
      CONSTREC = RECORD CASE CCLASS: CSTCLASS OF
                          LONG: (LLENG,LLAST: INTEGER;
                                 LONGVAL: ARRAY[1..9] OF INTEGER);
                          TRIX: (CSTVAL: ARRAY [1..8] OF INTEGER);
                                (*MUST COMPLETELY OVERLAP FOLLOWING FIELDS*)
                          REEL: (RVAL: REAL);
                          PSET: (PVAL: SET OF 0..127);
                          STRG: (SLGTH: 0..STRGLGTH;
                                 SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR)
                        END;

      VALU = RECORD CASE BOOLEAN OF
                      TRUE:  (IVAL: INTEGER);
                      FALSE: (VALP: CSP)
                    END;

                                                   (*DATA STRUCTURES*)
      BITRANGE = 0..BITSPERWD; OPRANGE = 0..80;
      CURSRANGE = 0..MAXCURSOR; PROCRANGE = 0..MAXPROCNUM;
      LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR;
      JTABRANGE = 0..MAXJTAB; SEGRANGE = 0..MAXSEG;
      DISPRANGE = 0..DISPLIMIT;

      STRUCTFORM = (SCALAR,SUBRANGE,POINTER,LONGINT,POWER,ARRAYS,
                    RECORDS,FILES,TAGFLD,VARIANT);

      DECLKIND = (STANDARD,DECLARED,SPECIAL);

      STP = ^ STRUCTURE; CTP = ^ IDENTIFIER;

      STRUCTURE = RECORD
                    SIZE: ADDRRANGE;
                    CASE FORM: STRUCTFORM OF
                      SCALAR:   (CASE SCALKIND: DECLKIND OF
                                   DECLARED: (FCONST: CTP));
                      SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU);
                      POINTER:  (ELTYPE: STP);
                      POWER:    (ELSET: STP);
                      ARRAYS:   (AELTYPE,INXTYPE: STP;
                                 CASE AISPACKD:BOOLEAN OF
                                   TRUE: (ELSPERWD,ELWIDTH: BITRANGE;
                                          CASE AISSTRNG: BOOLEAN OF
                                           TRUE:(MAXLENG: 1..STRGLGTH)));
                      RECORDS:  (FSTFLD: CTP; RECVAR: STP);
                      FILES:    (FILTYPE: STP);
                      TAGFLD:   (TAGFIELDP: CTP; FSTVAR: STP);
                      VARIANT:  (NXTVAR,SUBVAR: STP; VARVAL: VALU)
                    END;

                                                             (*NAMES*)
      IDCLASS = (TYPES,KONST,FORMALVARS,ACTUALVARS,FIELD,
                 PROC,FUNC,MODULE);
      SETOFIDS = SET OF IDCLASS;
      IDKIND = (ACTUAL,FORMAL);
      ALPHA = PACKED ARRAY [1..8] OF CHAR;

      IDENTIFIER = RECORD
                    NAME: ALPHA; LLINK, RLINK: CTP;
                    IDTYPE: STP; NEXT: CTP;
                    CASE KLASS: IDCLASS OF
                      KONST: (VALUES: VALU);
                 FORMALVARS,
                 ACTUALVARS: (VLEV: LEVRANGE;
                              VADDR: ADDRRANGE;
                              CASE BOOLEAN OF
                                TRUE: (PUBLIC: BOOLEAN));
                      FIELD: (FLDADDR: ADDRRANGE;
                              CASE FISPACKD: BOOLEAN OF
                                TRUE: (FLDRBIT,FLDWIDTH: BITRANGE));
                      PROC,
                      FUNC:  (CASE PFDECKIND: DECLKIND OF
                               SPECIAL:  (KEY: INTEGER);
                               STANDARD: (CSPNUM: INTEGER);
                               DECLARED: (PFLEV: LEVRANGE;
                                          PFNAME: PROCRANGE;
                                          PFSEG: SEGRANGE;
                                          CASE PFKIND: IDKIND OF
                                           ACTUAL: (LOCALLC: ADDRRANGE;
                                                    FORWDECL: BOOLEAN;
                                                    EXTURNAL: BOOLEAN;
                                                    INSCOPE: BOOLEAN;
                                                    CASE BOOLEAN OF
                                                     TRUE: (IMPORTED:BOOLEAN))));
                    MODULE: (SEGID: INTEGER)
                    END;


      WHERE = (BLCK,CREC,VREC,REC);

                                               (*EXPRESSIONS*)
      ATTRKIND = (CST,VARBL,EXPR);
      VACCESS = (DRCT,INDRCT,PACKD,MULTI,BYTE);

      ATTR = RECORD TYPTR: STP;
               CASE KIND: ATTRKIND OF
                 CST:   (CVAL: VALU);
                 VARBL: (CASE ACCESS: VACCESS OF
                           DRCT:   (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE);
                           INDRCT: (IDPLMT: ADDRRANGE))
             END;

      TESTP = ^ TESTPOINTER;
      TESTPOINTER = RECORD
                      ELT1,ELT2 : STP;
                      LASTTESTP : TESTP
                    END;

                                                    (*LABELS*)
      LBP = ^ CODELABEL;
      CODELABEL = RECORD
                    CASE DEFINED: BOOLEAN OF
                      FALSE: (REFLIST: ADDRRANGE);
                      TRUE:  (OCCURIC: ADDRRANGE; JTABINX: JTABRANGE)
                  END;

      LABELP = ^ USERLABEL;
      USERLABEL = RECORD
                    LABVAL: INTEGER;
                    NEXTLAB: LABELP;
                    CODELBP: LBP
                  END;

      REFARRAY = ARRAY[1..REFSPERBLK] OF
                   RECORD
                     KEY,OFFSET: INTEGER
                   END;

      CODEARRAY = PACKED ARRAY [0..MAXCODE] OF CHAR;
      SYMBUFARRAY = PACKED ARRAY [CURSRANGE] OF CHAR;

      UNITFILE = (WORKCODE,SYSLIBRARY);

      LEXSTKREC = RECORD
                    DOLDTOP: DISPRANGE;
                    DOLDLEV: 0..MAXLEVEL;
                    POLDPROC,SOLDPROC: PROCRANGE;
                    DOLDSEG: SEGRANGE;
                    DLLC: ADDRRANGE;
                    BFSY: SYMBOL;
                    DFPROCP: CTP;
                    DMARKP: ^INTEGER;
                    ISSEGMENT: BOOLEAN;
                    PREVLEXSTACKP: ^LEXSTKREC
                  END;


 (*--------------------------------------------------------------------*)

 VAR

     CODEP: ^ CODEARRAY;             (*CODE BUFFER UNTIL WRITEOUT*)
     SYMBUFP: ^ SYMBUFARRAY;         (*SYMBOLIC BUFFER...ASCII OR CODED*)

     GATTR: ATTR;                    (*DESCRIBES CURRENT EXPRESSION*)

     TOP: DISPRANGE;                 (*TOP OF DISPLAY*)
     LC,IC: ADDRRANGE;               (*LOCATION AND INSTRUCT COUNTERS*)
     TEST: BOOLEAN;
     INTPTR: STP;                    (*POINTER TO STANDARD INTEGER TYPE*)
     SEG: SEGRANGE;                  (*CURRENT SEGMENT NO.*)
                                     (*SCANNER GLOBALS...NEXT FOUR VARS*)
                                     (*MUST BE IN THIS ORDER FOR IDSEARCH*)
     SYMCURSOR: CURSRANGE;           (*CURRENT SCANNING INDEX IN SYMBUFP^*)
     SY: SYMBOL;                     (*SYMBOL FOUND BY INSYMBOL*)
     OP: OPERATOR;                   (*CLASSIFICATION OF LAST SYMBOL*)
     ID: ALPHA;                      (*LAST IDENTIFIER FOUND*)

     LGTH: INTEGER;                  (*LENGTH OF LAST STRING CONSTANT IN CHARS
                                       OR LEN OF LAST LONG INTEGER CONSTANT
                                        IN DIGITS*)
     VAL: VALU;                      (*VALUE OF LAST CONSTANT*)
     DISX: DISPRANGE;                (*LEVEL OF LAST ID SEARCHED*)

     LCMAX: ADDRRANGE;               (*TEMPORARIES LOCATION COUNTER*)

                                     (*SWITCHES:*)

     PRTERR,GOTOOK,RANGECHECK,DEBUGGING,
     NOISY,CODEINSEG,IOCHECK,BPTONLINE,
     CLINKERINFO,DLINKERINFO,LIST,TINY,LSEPPROC,
     DP,INCLUDING,USING,NOSWAP,SEPPROC,
     STARTINGUP,INMODULE,ININTERFACE,
     LIBNOTOPEN,SYSCOMP,PUBLICPROCS,GETSTMTLEV: BOOLEAN;

                                     (*POINTERS:*)
     (*INTPTR,*)REALPTR,LONGINTPTR,
     CHARPTR,BOOLPTR,
     TEXTPTR,NILPTR,
     INTRACTVPTR,STRGPTR: STP;       (*POINTERS TO STANDARD IDS*)

     UTYPPTR,UCSTPTR,UVARPTR,
     UFLDPTR,UPRCPTR,UFCTPTR,        (*POINTERS TO UNDECLARED IDS*)
     MODPTR,INPUTPTR,OUTPUTPTR,
     OUTERBLOCK,FWPTR,USINGLIST: CTP;

     GLOBTESTP: TESTP;               (*LAST TESTPOINTER*)

     LEVEL: LEVRANGE;                (*CURRENT STATIC LEVEL*)
     BEGSTMTLEV,STMTLEV: INTEGER;    (*CURRENT STATEMENT NESTING LEVEL*)
     MARKP: ^INTEGER;                (*FOR MARKING HEAP*)
     TOS: ^LEXSTKREC;                (*TOP OF LEX STACK*)
     GLEV: DISPRANGE;                (*GLOBAL LEVEL OF DISPLAY*)
     NEWBLOCK: BOOLEAN;              (*INDICATES NEED TO PUSH LEX STACK*)

     NEXTSEG: SEGRANGE;              (*NEXT SEGMENT #*)
     SEGINX: INTEGER;                (*CURRENT INDEX IN SEGMENT*)
     SCONST: CSP;                    (*INSYMBOL STRING RESULTS*)

     LOWTIME,LINEINFO,SCREENDOTS,STARTDOTS,SYMBLK,SMALLESTSPACE: INTEGER;
     LINESTART: CURSRANGE;

     CURPROC,NEXTPROC: PROCRANGE;     (*PROCEDURE NUMBER ASSIGNMENT*)

     CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,
     BLOCKBEGSYS,SELECTSYS,FACBEGSYS,STATBEGSYS,TYPEDELS: SETOFSYS;
     VARS: SETOFIDS;

     DISPLAY: ARRAY [DISPRANGE] OF
                 RECORD
                   FNAME: CTP;
                   CASE OCCUR: WHERE OF
                     BLCK: (FFILE: CTP; FLABEL: LABELP);
                     CREC: (CLEV: LEVRANGE; CDSPL: ADDRRANGE);
                     VREC: (VDSPL: ADDRRANGE)
                   END;

     PFNUMOF: NONRESPFLIST;

     PROCTABLE: ARRAY [PROCRANGE] OF INTEGER;

     SEGTABLE: ARRAY [SEGRANGE] OF
                 RECORD
                   DISKADDR,CODELENG: INTEGER;
                   SEGNAME: ALPHA;
                   SEGKIND,
                   TEXTADDR: INTEGER
                 END (*SEGTABLE*) ;

     COMMENT: ^STRING;
     SYSTEMLIB: STRING[40];
     NEXTJTAB: JTABRANGE;
     JTAB: ARRAY [JTABRANGE] OF INTEGER;

     REFFILE: FILE;
     NREFS,REFBLK: INTEGER;
     REFLIST: ^REFARRAY;
     OLDSYMBLK,PREVSYMBLK: INTEGER;
     OLDSYMCURSOR,OLDLINESTART,PREVSYMCURSOR,PREVLINESTART: CURSRANGE;
     USEFILE: UNITFILE;
     INCLFILE,LIBRARY: FILE;
     LP: TEXT;

     CURBYTE, CURBLK: INTEGER;
     DISKBUF: PACKED ARRAY [0..511] OF CHAR;

 (*--------------------------------------------------------------------*)

 (* FORWARD DECLARED PROCEDURES NEEDED BY COMPINIT *)

 PROCEDURE ERROR(ERRORNUM: INTEGER);
   FORWARD;
 PROCEDURE GETNEXTPAGE;
   FORWARD;
 PROCEDURE PRINTLINE;
   FORWARD;
 PROCEDURE ENTERID(FCP: CTP);
   FORWARD;
 PROCEDURE INSYMBOL;
   FORWARD;

 (* FORWARD DECLARED PROCEDURES USED IN BOTH DECLARATIONPART AND BODYPART *)

 PROCEDURE SEARCHSECTION(FCP:CTP; VAR FCP1: CTP);
   FORWARD;
 PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP);
   FORWARD;
 PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER);
   FORWARD;
 PROCEDURE SKIP(FSYS: SETOFSYS);
   FORWARD;
 FUNCTION PAOFCHAR(FSP: STP): BOOLEAN;
   FORWARD;
 FUNCTION STRGTYPE(FSP: STP): BOOLEAN;
   FORWARD;
 FUNCTION DECSIZE(I: INTEGER): INTEGER;
   FORWARD;
 PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);
   FORWARD;
 FUNCTION COMPTYPES(FSP1,FSP2: STP): BOOLEAN;
   FORWARD;
 PROCEDURE GENBYTE(FBYTE: INTEGER);
   FORWARD;
 PROCEDURE GENWORD(FWORD: INTEGER);
   FORWARD;
 PROCEDURE WRITETEXT;
   FORWARD;
 PROCEDURE WRITECODE(FORCEBUF: BOOLEAN);
   FORWARD;
 PROCEDURE BLOCK(FSYS: SETOFSYS);
   FORWARD;

 (* $I COMPINIT.TEXT*)

 SEGMENT PROCEDURE COMPINIT;

   PROCEDURE ENTSTDTYPES;
   BEGIN
     NEW(INTPTR,SCALAR,STANDARD);
     WITH INTPTR^ DO
       BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
     NEW(REALPTR,SCALAR,STANDARD);
     WITH REALPTR^ DO
       BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
     NEW(LONGINTPTR,LONGINT);
     WITH LONGINTPTR^ DO
       BEGIN SIZE := INTSIZE; FORM := LONGINT END;
     NEW(CHARPTR,SCALAR,STANDARD);
     WITH CHARPTR^ DO
       BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
     NEW(BOOLPTR,SCALAR,DECLARED);
     WITH BOOLPTR^ DO
       BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END;
     NEW(NILPTR,POINTER);
     WITH NILPTR^ DO
       BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE := NIL END;
     NEW(TEXTPTR,FILES);
     WITH TEXTPTR^ DO
       BEGIN SIZE := FILESIZE+CHARSIZE; FORM := FILES; FILTYPE := CHARPTR END;
     NEW(INTRACTVPTR,FILES);
     WITH INTRACTVPTR^ DO
       BEGIN SIZE := FILESIZE+CHARSIZE; FORM := FILES; FILTYPE := CHARPTR END;
     NEW(STRGPTR,ARRAYS,TRUE,TRUE);
     WITH STRGPTR^ DO
       BEGIN FORM := ARRAYS; SIZE := (DEFSTRGLGTH + CHRSPERWD) DIV CHRSPERWD;
         AISPACKD := TRUE; AISSTRNG := TRUE; INXTYPE := INTPTR;
         ELWIDTH := BITSPERCHR; ELSPERWD := CHRSPERWD;
         AELTYPE := CHARPTR; MAXLENG := DEFSTRGLGTH;
       END
   END (*ENTSTDTYPES*) ;

   PROCEDURE ENTSTDNAMES;
     VAR CP,CP1: CTP; I: INTEGER;
   BEGIN
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'REAL    '; IDTYPE := REALPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'CHAR    '; IDTYPE := CHARPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'BOOLEAN '; IDTYPE := BOOLPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'STRING  '; IDTYPE := STRGPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'TEXT    '; IDTYPE := TEXTPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(CP,TYPES);
     WITH CP^ DO
       BEGIN NAME := 'INTERACT'; IDTYPE := INTRACTVPTR; KLASS := TYPES END;
     ENTERID(CP);
     NEW(INPUTPTR,FORMALVARS,FALSE);
     WITH INPUTPTR^ DO
       BEGIN NAME := 'INPUT   '; IDTYPE := TEXTPTR; KLASS := FORMALVARS;
         VLEV := 0; VADDR := 2
       END;
     ENTERID(INPUTPTR);
     NEW(OUTPUTPTR,FORMALVARS,FALSE);
     WITH OUTPUTPTR^ DO
       BEGIN NAME := 'OUTPUT  '; IDTYPE := TEXTPTR; KLASS := FORMALVARS;
         VLEV := 0; VADDR := 3
       END;
     ENTERID(OUTPUTPTR);
     NEW(CP,FORMALVARS,FALSE);
     WITH CP^ DO
       BEGIN NAME := 'KEYBOARD'; IDTYPE := TEXTPTR; KLASS := FORMALVARS;
         VLEV := 0; VADDR := 4
       END;
     ENTERID(CP);
     CP1 := NIL;
     FOR I := 0 TO 1 DO
       BEGIN NEW(CP,KONST);
         WITH CP^ DO
           BEGIN IDTYPE := BOOLPTR;
             IF I = 0 THEN NAME := 'FALSE   '
             ELSE NAME := 'TRUE    ';
             NEXT := CP1; VALUES.IVAL := I; KLASS := KONST
           END;
         ENTERID(CP); CP1 := CP
       END;
     BOOLPTR^.FCONST := CP;
     NEW(CP,KONST);
     WITH CP^ DO
       BEGIN NAME := 'NIL     '; IDTYPE := NILPTR;
         NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST
       END;
     ENTERID(CP);
     NEW(CP,KONST);
     WITH CP^ DO
       BEGIN
         NAME := 'MAXINT  '; IDTYPE := INTPTR;
         KLASS := KONST; VALUES.IVAL := MAXINT
       END;
     ENTERID(CP);
   END (*ENTSTDNAMES*) ;

   PROCEDURE ENTUNDECL;
   BEGIN
     NEW(UTYPPTR,TYPES);
     WITH UTYPPTR^ DO
       BEGIN NAME := '        '; IDTYPE := NIL; KLASS := TYPES END;
     NEW(UCSTPTR,KONST);
     WITH UCSTPTR^ DO
       BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
         VALUES.IVAL := 0; KLASS := KONST
       END;
     NEW(UVARPTR,ACTUALVARS,FALSE);
     WITH UVARPTR^ DO
       BEGIN NAME := '        '; IDTYPE := NIL;
         NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := ACTUALVARS
       END;
     NEW(UFLDPTR,FIELD);
     WITH UFLDPTR^ DO
       BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
         FLDADDR := 0; KLASS := FIELD
       END;
     NEW(UPRCPTR,PROC,DECLARED,ACTUAL,FALSE);
     WITH UPRCPTR^ DO
       BEGIN NAME := '        '; IDTYPE := NIL; FORWDECL := FALSE;
         NEXT := NIL; INSCOPE := FALSE; LOCALLC := 0; EXTURNAL := FALSE;
         PFLEV := 0; PFNAME := 0; PFSEG := 0;
         KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL
       END;
     NEW(UFCTPTR,FUNC,DECLARED,ACTUAL,FALSE);
     WITH UFCTPTR^ DO
       BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
         FORWDECL := FALSE; EXTURNAL := FALSE; INSCOPE := FALSE; LOCALLC := 0;
         PFLEV := 0; PFNAME := 0; PFSEG := 0;
         KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
       END
   END (*ENTUNDECL*) ;

   PROCEDURE ENTSPCPROCS;
     LABEL 1;
     VAR LCP: CTP; I: INTEGER; ISFUNC: BOOLEAN;
         NA: ARRAY [1..43] OF ALPHA;

   BEGIN
     NA[ 1] := 'READ    '; NA[ 2] := 'READLN  '; NA[ 3] := 'WRITE   ';
     NA[ 4] := 'WRITELN '; NA[ 5] := 'EOF     '; NA[ 6] := 'EOLN    ';
     NA[ 7] := 'PRED    '; NA[ 8] := 'SUCC    '; NA[ 9] := 'ORD     ';
     NA[10] := 'SQR     '; NA[11] := 'ABS     '; NA[12] := 'NEW     ';
     NA[13] := 'UNITREAD'; NA[14] := 'UNITWRIT'; NA[15] := 'CONCAT  ';
     NA[16] := 'LENGTH  '; NA[17] := 'INSERT  '; NA[18] := 'DELETE  ';
     NA[19] := 'COPY    '; NA[20] := 'POS     '; NA[21] := 'MOVELEFT';
     NA[22] := 'MOVERIGH'; NA[23] := 'EXIT    '; NA[24] := 'IDSEARCH';
     NA[25] := 'TREESEAR'; NA[26] := 'TIME    '; NA[27] := 'FILLCHAR';
     NA[28] := 'OPENNEW '; NA[29] := 'OPENOLD '; NA[30] := 'REWRITE ';
     NA[31] := 'CLOSE   '; NA[32] := 'SEEK    '; NA[33] := 'RESET   ';
     NA[34] := 'GET     '; NA[35] := 'PUT     '; NA[36] := 'SCAN    ';
     NA[37] := 'BLOCKREA'; NA[38] := 'BLOCKWRI'; NA[39] := 'TRUNC   ';
     NA[40] := 'PAGE    '; NA[41] := 'SIZEOF  '; NA[42] := 'STR     ';
     NA[43] := 'GOTOXY  ';
     FOR I := 1 TO 43 DO
       BEGIN
         IF TINY THEN
             IF I IN [2,7,8,10,13,17,18,19,20,32,34,35,40,42,43] THEN
               GOTO 1;
         ISFUNC := I IN [5,6,7,8,9,10,11,15,16,19,20,25,36,37,38,39,41];
         IF ISFUNC THEN NEW(LCP,FUNC,SPECIAL)
         ELSE NEW(LCP,PROC,SPECIAL);
         WITH LCP^ DO
           BEGIN NAME := NA[I]; NEXT := NIL; IDTYPE := NIL;
             IF ISFUNC THEN KLASS := FUNC ELSE KLASS := PROC;
             PFDECKIND := SPECIAL; KEY := I
           END;
         ENTERID(LCP);
 1:    END
     END (*ENTSPCPROCS*) ;

   PROCEDURE ENTSTDPROCS;
     VAR LCP,PARAM: CTP; LSP,FTYPE: STP; I: INTEGER; ISPROC: BOOLEAN;
         NA: ARRAY [1..19] OF ALPHA;
   BEGIN
     NA[ 1] := 'ODD     '; NA[ 2] := 'CHR     '; NA[ 3] := 'MEMAVAIL';
     NA[ 4] := 'ROUND   '; NA[ 5] := 'SIN     '; NA[ 6] := 'COS     ';
     NA[ 7] := 'LOG     '; NA[ 8] := 'ATAN    '; NA[ 9] := 'LN      ';
     NA[10] := 'EXP     '; NA[11] := 'SQRT    '; NA[12] := 'MARK    ';
     NA[13] := 'RELEASE '; NA[14] := 'IORESULT'; NA[15] := 'UNITBUSY';
     NA[16] := 'PWROFTEN'; NA[17] := 'UNITWAIT'; NA[18] := 'UNITCLEA';
     NA[19] := 'HALT    ';
     FOR I := 1 TO 19 DO
       BEGIN ISPROC := I IN [12,13,17,18,19];
         CASE I OF
           1:  BEGIN FTYPE := BOOLPTR; NEW(PARAM,ACTUALVARS,FALSE);
                 WITH PARAM^ DO
                   BEGIN IDTYPE := INTPTR; KLASS := ACTUALVARS END
               END;
           2:  FTYPE := CHARPTR;
           3:  BEGIN FTYPE := INTPTR; PARAM := NIL END;
           4:  BEGIN FTYPE := INTPTR; NEW(PARAM,ACTUALVARS,FALSE);
                 WITH PARAM^ DO BEGIN IDTYPE := REALPTR; KLASS := ACTUALVARS END
               END;
           5:  FTYPE := REALPTR;
          12:  BEGIN FTYPE := NIL; NEW(PARAM,FORMALVARS,FALSE); NEW(LSP,POINTER);
                 WITH LSP^ DO
                   BEGIN SIZE := PTRSIZE; FORM := POINTER; ELTYPE := NIL END;
                 WITH PARAM^ DO BEGIN IDTYPE := LSP; KLASS := FORMALVARS END
               END;
          14:  BEGIN FTYPE := INTPTR; PARAM := NIL END;
          15:  BEGIN FTYPE := BOOLPTR; NEW(PARAM,ACTUALVARS,FALSE);
               WITH PARAM^ DO
                 BEGIN IDTYPE := INTPTR; KLASS := ACTUALVARS END;
               END;
          16:  FTYPE := REALPTR;
          17:  FTYPE := NIL;
          19:  BEGIN FTYPE := NIL; PARAM := NIL END
         END (*PARAM AND TYPE CASES*) ;
         IF ISPROC THEN NEW(LCP,PROC,STANDARD)
         ELSE NEW(LCP,FUNC,STANDARD);
         WITH LCP^ DO
           BEGIN NAME := NA[I]; PFDECKIND := STANDARD; CSPNUM := I + 20;
             IF ISPROC THEN KLASS := PROC ELSE KLASS := FUNC;
             IF PARAM <> NIL THEN PARAM^.NEXT := NIL;
             IDTYPE := FTYPE; NEXT := PARAM
           END;
         ENTERID(LCP)
       END
     END (*ENTSTDPROCS*) ;

   PROCEDURE INITSCALARS;
    VAR I: NONRESIDENT;
   BEGIN
     FWPTR := NIL; MODPTR := NIL; GLOBTESTP := NIL;
     LINESTART := 0; LINEINFO := LCAFTERMARKSTACK; LIST := FALSE;
     SYMBLK := 2; SCREENDOTS := 0; STARTDOTS := 0;
     FOR SEG := 0 TO MAXSEG DO
       WITH SEGTABLE[SEG] DO
         BEGIN DISKADDR := 0; CODELENG := 0; SEGNAME := '        ';
           SEGKIND := 0; TEXTADDR := 0
         END;
     USINGLIST := NIL;
     IF USERINFO.STUPID THEN SYSTEMLIB := '*SYSTEM.PASCAL'
     ELSE SYSTEMLIB := '*SYSTEM.LIBRARY';
     LC := LCAFTERMARKSTACK; IOCHECK := TRUE; DP := TRUE;
     SEGINX := 0; NEXTJTAB := 1; NEXTPROC := 2; CURPROC := 1;
     NEW(SCONST); NEW(SYMBUFP); NEW(CODEP);
     CLINKERINFO := FALSE; DLINKERINFO := FALSE;
     SEG := 1; NEXTSEG := 10; CURBLK := 1; CURBYTE := 0; LSEPPROC := FALSE;
     STARTINGUP := TRUE; NOISY := NOT USERINFO.SLOWTERM; SEPPROC := FALSE;
     NOSWAP := TRUE; DEBUGGING := FALSE; BPTONLINE := FALSE; INMODULE := FALSE;
     GOTOOK := FALSE; RANGECHECK := TRUE; SYSCOMP := FALSE; TINY := FALSE;
     CODEINSEG := FALSE; PRTERR := TRUE; INCLUDING := FALSE; USING := FALSE;
     FOR I := SEEK TO DECOPS DO PFNUMOF[I] := 0;
     COMMENT := NIL; LIBNOTOPEN := TRUE;
     GETSTMTLEV := TRUE; BEGSTMTLEV := 0
   END (*INITSCALARS*) ;

   PROCEDURE INITSETS;

   BEGIN
     CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];
     SIMPTYPEBEGSYS := [LPARENT] + CONSTBEGSYS;
     TYPEBEGSYS := [ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY]
                   + SIMPTYPEBEGSYS;
     TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
     BLOCKBEGSYS := [USESSY,LABELSY,CONSTSY,TYPESY,VARSY,
                     PROCSY,FUNCSY,PROGSY,BEGINSY];
     SELECTSYS := [ARROW,PERIOD,LBRACK];
     FACBEGSYS := [INTCONST,REALCONST,LONGCONST,STRINGCONST,IDENT,
                   LPARENT,LBRACK,NOTSY];
     STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,CASESY];
     VARS := [FORMALVARS,ACTUALVARS]
   END (*INITSETS*) ;

 BEGIN (*COMPINIT*)
   INITSCALARS; INITSETS;
   LEVEL := 0; TOP := 0;
   IF NOISY THEN
     BEGIN
       FOR IC := 1 TO 7 DO WRITELN(OUTPUT);
       WRITELN(OUTPUT,'PASCAL Compiler [I.5] (Unit Compiler)');
       WRITE(OUTPUT,'<   0>')
     END;
   WITH DISPLAY[0] DO
     BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END;
   SMALLESTSPACE:=MEMAVAIL;
   GETNEXTPAGE;
   INSYMBOL;
   ENTSTDTYPES;   ENTSTDNAMES;   ENTUNDECL;
   ENTSPCPROCS;   ENTSTDPROCS;
   IF SYSCOMP THEN
     BEGIN OUTERBLOCK := NIL; SEG := 0; NEXTSEG := 1;
       GLEV :=1; BLOCKBEGSYS := BLOCKBEGSYS + [UNITSY,SEPARATSY]
     END
   ELSE
     BEGIN TOP := 1; LEVEL := 1;
       WITH DISPLAY[1] DO
         BEGIN FNAME := NIL; FFILE := NIL;
           FLABEL := NIL; OCCUR := BLCK
         END;
       LC := LC+2; GLEV := 3; (*KEEP STACK STRAIGHT FOR NOW*)
       NEW(OUTERBLOCK,PROC,DECLARED,ACTUAL,FALSE);
       WITH OUTERBLOCK^ DO
         BEGIN NEXT := NIL; LOCALLC := LC;
           NAME := 'PROGRAM '; IDTYPE := NIL; KLASS := PROC;
           PFDECKIND := DECLARED; PFLEV := 0; PFNAME := 1; PFSEG := SEG;
           PFKIND := ACTUAL; FORWDECL := FALSE; EXTURNAL := FALSE;
           INSCOPE := TRUE
         END
     END;
   IF SY = PROGSY THEN
     BEGIN INSYMBOL;
       IF SY = IDENT THEN
         BEGIN SEGTABLE[SEG].SEGNAME := ID;
           IF OUTERBLOCK <> NIL THEN
             BEGIN
               OUTERBLOCK^.NAME := ID;
               ENTERID(OUTERBLOCK) (*ALLOWS EXIT ON PROGRAM NAME*)
             END
         END
       ELSE ERROR(2); INSYMBOL;
       IF SY = LPARENT THEN
         BEGIN
           REPEAT INSYMBOL
           UNTIL SY IN [RPARENT,SEMICOLON]+BLOCKBEGSYS;
           IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
         END;
       IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
     END;
   MARK(MARKP);
   NEW(TOS);
   WITH TOS^ DO  (*MAKE LEXSTKREC FOR OUTERBLOCK*)
     BEGIN
       PREVLEXSTACKP:=NIL;
       BFSY:=PERIOD;
       DFPROCP:=OUTERBLOCK;
       DLLC:=LC;
       DOLDLEV:=LEVEL;
       DOLDTOP:=TOP;
       POLDPROC:=CURPROC;
       ISSEGMENT:=FALSE;
       DMARKP:=MARKP;
     END;
 END (*COMPINIT*) ;
	
 (* $I DECPART.A.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

 SEGMENT PROCEDURE DECLARATIONPART(FSYS: SETOFSYS);
 VAR LSY: SYMBOL;
     NOTDONE: BOOLEAN;
     DUMMYVAR: ARRAY[0..0] OF INTEGER; (*FOR PRETTY DISPLAY OF STACK AND HEAP *)

   PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE);
     VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP;
         LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER;
         PACKING: BOOLEAN; NEXTBIT,NUMBITS: BITRANGE;

     PROCEDURE SIMPLETYPE(FSYS:SETOFSYS; VAR FSP:STP; VAR FSIZE:ADDRRANGE);
       VAR LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE;
           LCNT: INTEGER; LVALU: VALU;
     BEGIN FSIZE := 1;
       IF NOT (SY IN SIMPTYPEBEGSYS) THEN
         BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END;
       IF SY IN SIMPTYPEBEGSYS THEN
         BEGIN
           IF SY = LPARENT THEN
             BEGIN TTOP := TOP;
               WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP := TOP - 1;
               NEW(LSP,SCALAR,DECLARED);
               WITH LSP^ DO
                 BEGIN SIZE := INTSIZE; FORM := SCALAR;
                   SCALKIND := DECLARED
                 END;
               LCP1 := NIL; LCNT := 0;
               REPEAT INSYMBOL;
                 IF SY = IDENT THEN
                   BEGIN NEW(LCP,KONST);
                     WITH LCP^ DO
                       BEGIN NAME := ID; IDTYPE := LSP; NEXT := LCP1;
                         VALUES.IVAL := LCNT; KLASS := KONST
                       END;
                     ENTERID(LCP);
                     LCNT := LCNT + 1;
                     LCP1 := LCP; INSYMBOL
                   END
                 ELSE ERROR(2);
                 IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
                   BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END
               UNTIL SY <> COMMA;
               LSP^.FCONST := LCP1; TOP := TTOP;
               IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
             END
           ELSE
             BEGIN
               IF SY = IDENT THEN
                 BEGIN SEARCHID([TYPES,KONST],LCP);
                   INSYMBOL;
                   IF LCP^.KLASS = KONST THEN
                     BEGIN NEW(LSP,SUBRANGE);
                       WITH LSP^, LCP^ DO
                         BEGIN RANGETYPE := IDTYPE; FORM := SUBRANGE;
                           IF STRGTYPE(RANGETYPE) THEN
                             BEGIN ERROR(148); RANGETYPE := NIL END;
                           MIN := VALUES; SIZE := INTSIZE
                         END;
                       IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                       CONSTANT(FSYS,LSP1,LVALU);
                       LSP^.MAX := LVALU;
                       IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107)
                     END
                   ELSE
                     BEGIN LSP := LCP^.IDTYPE;
                       IF (LSP = STRGPTR) AND (SY = LBRACK) THEN
                         BEGIN INSYMBOL;
                           CONSTANT(FSYS + [RBRACK],LSP1,LVALU);
                           IF LSP1 = INTPTR THEN
                             BEGIN
                               IF (LVALU.IVAL <= 0) OR
                                  (LVALU.IVAL > STRGLGTH) THEN
                                 BEGIN ERROR(203);
                                   LVALU.IVAL := DEFSTRGLGTH
                                 END;
                               IF LVALU.IVAL <> DEFSTRGLGTH THEN
                                 BEGIN NEW(LSP,ARRAYS,TRUE,TRUE);
                                   LSP^ := STRGPTR^;
                                   WITH LSP^,LVALU DO
                                     BEGIN MAXLENG := IVAL;
                                       SIZE := (IVAL+CHRSPERWD) DIV CHRSPERWD
                                     END
                                 END
                             END
                           ELSE ERROR(15);
                           IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
                         END
                       ELSE
                         IF LSP = INTPTR THEN
                           IF SY = LBRACK THEN
                             BEGIN INSYMBOL;
                               NEW(LSP,LONGINT);
                               LSP^ := LONGINTPTR^;
                               CONSTANT(FSYS + [RBRACK],LSP1,LVALU);
                               IF LSP1 = INTPTR THEN
                                 IF (LVALU.IVAL <= 0) OR
                                    (LVALU.IVAL > MAXDEC) THEN ERROR(203)
                                 ELSE
                                   LSP^.SIZE := DECSIZE(LVALU.IVAL)
                               ELSE ERROR(15);
                               IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
                             END
                           ELSE
                             IF LSP^.FORM = FILES THEN
                               IF INMODULE THEN
                                 IF NOT ININTERFACE THEN
                                   ERROR(191); (*NO PRIVATE FILES*)
                       IF LSP <> NIL THEN FSIZE := LSP^.SIZE
                     END
                 END (*SY = IDENT*)
               ELSE
                 BEGIN NEW(LSP,SUBRANGE); LSP^.FORM := SUBRANGE;
                   CONSTANT(FSYS + [COLON],LSP1,LVALU);
                   IF STRGTYPE(LSP1) THEN
                     BEGIN ERROR(148); LSP1 := NIL END;
                   WITH LSP^ DO
                     BEGIN RANGETYPE:=LSP1; MIN:=LVALU; SIZE:=INTSIZE END;
                   IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                   CONSTANT(FSYS,LSP1,LVALU);
                   LSP^.MAX := LVALU;
                   IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107)
                 END;
               IF LSP <> NIL THEN
                 WITH LSP^ DO
                   IF FORM = SUBRANGE THEN
                     IF RANGETYPE <> NIL THEN
                       IF RANGETYPE = REALPTR THEN ERROR(399)
                       ELSE
                         IF MIN.IVAL > MAX.IVAL THEN
                           BEGIN ERROR(102); MAX.IVAL := MIN.IVAL END
             END;
           FSP := LSP;
           IF NOT (SY IN FSYS) THEN
             BEGIN ERROR(6); SKIP(FSYS) END
         END
           ELSE FSP := NIL
     END (*SIMPLETYPE*) ;

     FUNCTION PACKABLE(FSP: STP): BOOLEAN;
       VAR LMIN,LMAX: INTEGER;
     BEGIN PACKABLE := FALSE;
       IF (FSP <> NIL) AND PACKING THEN
         WITH FSP^ DO
           CASE FORM OF
             SUBRANGE,
             SCALAR:  IF (FSP <> INTPTR) AND (FSP <> REALPTR) THEN
                        BEGIN GETBOUNDS(FSP,LMIN,LMAX);
                          IF LMIN >= 0 THEN
                            BEGIN PACKABLE := TRUE;
                              NUMBITS := 1; LMIN := 1;
                              WHILE LMIN < LMAX DO
                                BEGIN LMIN := LMIN + 1;
                                  LMIN := LMIN + LMIN - 1;
                                  NUMBITS := NUMBITS + 1
                                END
                            END
                        END;
             POWER:   IF PACKABLE(ELSET) THEN
                        BEGIN GETBOUNDS(ELSET,LMIN,LMAX);
                          LMAX := LMAX + 1;
                          IF LMAX < BITSPERWD THEN
                            BEGIN PACKABLE := TRUE;
                              NUMBITS := LMAX
                            END
                        END
           END (* CASES *);
     END (*PACKABLE*) ;

     PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP);
       VAR LCP,LCP1,NXT,NXT1,LAST: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP;
           MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU;
           MAXBIT,MINBIT: BITRANGE;

       PROCEDURE ALLOCATE(FCP: CTP);
         VAR ONBOUND: BOOLEAN;
       BEGIN ONBOUND := FALSE;
         WITH FCP^ DO
           IF PACKABLE(IDTYPE) THEN
             BEGIN
               IF (NUMBITS + NEXTBIT) > BITSPERWD THEN
                 BEGIN DISPL := DISPL + 1; NEXTBIT := 0; ONBOUND := TRUE END;
               FLDADDR := DISPL; FISPACKD := TRUE;
               FLDWIDTH := NUMBITS; FLDRBIT := NEXTBIT;
               NEXTBIT := NEXTBIT + NUMBITS
             END
           ELSE
             BEGIN DISPL := DISPL + ORD(NEXTBIT > 0);
               NEXTBIT := 0; ONBOUND := TRUE;
               FISPACKD := FALSE; FLDADDR := DISPL;
               IF IDTYPE <> NIL THEN
                 DISPL := DISPL + IDTYPE^.SIZE
             END;
         IF ONBOUND AND (LAST <> NIL) THEN
           WITH LAST^ DO
             IF FISPACKD THEN
               IF FLDRBIT = 0 THEN FISPACKD := FALSE
               ELSE
                 IF (FLDWIDTH <= 8) AND (FLDRBIT <= 8) THEN
                   BEGIN FLDWIDTH := 8; FLDRBIT := 8 END
       END (*ALLOCATE*) ;

       PROCEDURE VARIANTLIST;
         VAR GOTTAGNAME: BOOLEAN;
       BEGIN NEW(LSP,TAGFLD);
         WITH LSP^ DO
           BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM := TAGFLD END;
         FRECVAR := LSP;
         INSYMBOL;
         IF SY = IDENT THEN
           BEGIN
             IF PACKING THEN NEW(LCP,FIELD,TRUE)
             ELSE NEW(LCP,FIELD,FALSE);
             WITH LCP^ DO
               BEGIN IDTYPE := NIL; KLASS:=FIELD;
                 NEXT := NIL; FISPACKD := FALSE
               END;
             GOTTAGNAME := FALSE; PRTERR := FALSE;
             SEARCHID([TYPES],LCP1); PRTERR := TRUE;
             IF LCP1 = NIL THEN
               BEGIN GOTTAGNAME := TRUE;
                 LCP^.NAME := ID; ENTERID(LCP); INSYMBOL;
                 IF SY = COLON THEN INSYMBOL ELSE ERROR(5)
               END;
             IF SY = IDENT THEN
               BEGIN SEARCHID([TYPES],LCP1);
                 LSP1 := LCP1^.IDTYPE;
                 IF LSP1 <> NIL THEN
                   BEGIN
                     IF LSP1^.FORM <= SUBRANGE THEN
                       BEGIN
                         IF COMPTYPES(REALPTR,LSP1) THEN ERROR(109);
                         LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP;
                         IF GOTTAGNAME THEN ALLOCATE(LCP)
                       END
                     ELSE ERROR(110)
                   END;
                 INSYMBOL
               END
             ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END
           END
         ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END;
         LSP^.SIZE := DISPL + ORD(NEXTBIT > 0);
         IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
         LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL;
         MINBIT := NEXTBIT; MAXBIT := NEXTBIT;
         REPEAT LSP2 := NIL;
           REPEAT CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALU);
             IF LSP^.TAGFIELDP <> NIL THEN
               IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3) THEN
                 ERROR(111);
             NEW(LSP3,VARIANT);
             WITH LSP3^ DO
               BEGIN NXTVAR := LSP1; SUBVAR := LSP2;
                 VARVAL := LVALU; FORM := VARIANT
               END;
             LSP1 := LSP3; LSP2 := LSP3;
             TEST := SY <> COMMA;
             IF NOT TEST THEN INSYMBOL
           UNTIL TEST;
           IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
           IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);
           IF SY = RPARENT THEN LSP2 := NIL
           ELSE
             FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2);
           IF DISPL > MAXSIZE THEN
             BEGIN MAXSIZE := DISPL; MAXBIT := NEXTBIT END
           ELSE
             IF (DISPL = MAXSIZE) AND (NEXTBIT > MAXBIT) THEN
               MAXBIT := NEXTBIT;
           WHILE LSP3 <> NIL DO
             BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2;
               LSP3^.SIZE := DISPL + ORD(NEXTBIT > 0);
               LSP3 := LSP4
             END;
           IF SY = RPARENT THEN
             BEGIN INSYMBOL;
               IF NOT (SY IN FSYS + [SEMICOLON]) THEN
                 BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END
             END
           ELSE ERROR(4);
           TEST := SY <> SEMICOLON;
           IF NOT TEST THEN
             BEGIN INSYMBOL;
               DISPL := MINSIZE; NEXTBIT := MINBIT
             END
         UNTIL (TEST) OR (SY = ENDSY); (* <<<< SMF 2-28-78 *)
         DISPL := MAXSIZE; NEXTBIT := MAXBIT;
         LSP^.FSTVAR := LSP1
       END (*VARIANTLIST*) ;

     BEGIN (*FIELDLIST*)
       NXT1 := NIL; LSP := NIL; LAST := NIL;
       IF NOT (SY IN [IDENT,CASESY]) THEN
         BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END;
       WHILE SY = IDENT DO
         BEGIN NXT := NXT1;
           REPEAT
             IF SY = IDENT THEN
               BEGIN
                 IF PACKING THEN NEW(LCP,FIELD,TRUE)
                 ELSE NEW(LCP,FIELD,FALSE);
                 WITH LCP^ DO
                   BEGIN NAME := ID; IDTYPE := NIL; NEXT := NXT;
                     KLASS := FIELD; FISPACKD := FALSE
                   END;
                 NXT := LCP;
                 ENTERID(LCP);
                 INSYMBOL
               END
             ELSE ERROR(2);
             IF NOT (SY IN [COMMA,COLON]) THEN
               BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY]) END;
             TEST := SY <> COMMA;
             IF NOT TEST  THEN INSYMBOL
           UNTIL TEST;
           IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
           TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE);
           IF LSP <> NIL THEN
             IF LSP^.FORM = FILES THEN ERROR(108);
           WHILE NXT <> NXT1 DO
             WITH NXT^ DO
               BEGIN IDTYPE := LSP; ALLOCATE(NXT);
                 IF NEXT = NXT1 THEN LAST := NXT;
                 NXT := NEXT
               END;
           NXT1 := LCP;
           IF SY = SEMICOLON THEN
             BEGIN INSYMBOL;
               IF NOT (SY IN [IDENT,ENDSY,CASESY]) THEN (* <<<< SMF 2-28-78 *)
                 BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END
             END
         END (*WHILE*);
       NXT := NIL;
       WHILE NXT1 <> NIL DO
         WITH NXT1^ DO
           BEGIN LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 := LCP END;
       IF SY = CASESY THEN VARIANTLIST
       ELSE FRECVAR := NIL
     END (*FIELDLIST*) ;

     PROCEDURE POINTERTYPE;
     BEGIN NEW(LSP,POINTER); FSP := LSP;
       WITH LSP^ DO
         BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END;
       INSYMBOL;
       IF SY = IDENT THEN
         BEGIN PRTERR := FALSE;
           SEARCHID([TYPES],LCP); PRTERR := TRUE;
           IF LCP = NIL THEN   (*FORWARD REFERENCED TYPE ID*)
             BEGIN NEW(LCP,TYPES);
               WITH LCP^ DO
                 BEGIN NAME := ID; IDTYPE := LSP;
                   NEXT := FWPTR; KLASS := TYPES
                 END;
               FWPTR := LCP
             END
           ELSE
             BEGIN
               IF LCP^.IDTYPE <> NIL THEN
                 IF (LCP^.IDTYPE^.FORM <> FILES) OR SYSCOMP THEN
                   LSP^.ELTYPE := LCP^.IDTYPE
                 ELSE ERROR(108)
             END;
           INSYMBOL;
         END
       ELSE ERROR(2)
     END (*POINTERTYPE*) ;

   BEGIN (*TYP*)
     PACKING := FALSE;
     IF NOT (SY IN TYPEBEGSYS) THEN
        BEGIN ERROR(10); SKIP(FSYS + TYPEBEGSYS) END;
     IF SY IN TYPEBEGSYS THEN
       BEGIN
         IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP,FSIZE)
         ELSE
   (*^*)   IF SY = ARROW THEN POINTERTYPE
           ELSE
             BEGIN
               IF SY = PACKEDSY THEN
                 BEGIN INSYMBOL; PACKING := TRUE;
                   IF NOT (SY IN TYPEDELS) THEN
                     BEGIN ERROR(10); SKIP(FSYS + TYPEDELS) END
                 END;
   (*ARRAY*)   IF SY = ARRAYSY THEN
                 BEGIN INSYMBOL;
                   IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11);
                   LSP1 := NIL;
                   REPEAT
                     IF PACKING THEN NEW(LSP,ARRAYS,TRUE,FALSE)
                     ELSE NEW(LSP,ARRAYS,FALSE);
                     WITH LSP^ DO
                       BEGIN AELTYPE := LSP1; INXTYPE := NIL;
                         IF PACKING THEN AISSTRNG := FALSE;
                         AISPACKD := FALSE;  FORM := ARRAYS
                       END;
                     LSP1 := LSP;
                     SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2,LSIZE);
                     LSP1^.SIZE := LSIZE;
                     IF LSP2 <> NIL THEN
                       IF LSP2^.FORM <= SUBRANGE THEN
                         BEGIN
                           IF LSP2 = REALPTR THEN
                             BEGIN ERROR(109); LSP2 := NIL END
                           ELSE
                             IF LSP2 = INTPTR THEN
                               BEGIN ERROR(149); LSP2 := NIL END;
                           LSP^.INXTYPE := LSP2
                         END
                       ELSE BEGIN ERROR(113); LSP2 := NIL END;
                     TEST := SY <> COMMA;
                     IF NOT TEST THEN INSYMBOL
                   UNTIL TEST;
                   IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
                   IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
                   TYP(FSYS,LSP,LSIZE);
                   IF LSP <> NIL THEN
                     IF LSP^.FORM = FILES THEN ERROR(108);
                   IF PACKABLE(LSP) THEN
                     IF NUMBITS + NUMBITS <= BITSPERWD THEN
                       WITH LSP1^ DO
                         BEGIN AISPACKD := TRUE;
                           ELSPERWD := BITSPERWD DIV NUMBITS;
                           ELWIDTH := NUMBITS
                         END;
                   REPEAT
                     WITH LSP1^ DO
                       BEGIN LSP2 := AELTYPE; AELTYPE := LSP;
                         IF INXTYPE <> NIL THEN
                           BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                             IF AISPACKD THEN
                               LSIZE := (LMAX-LMIN+ELSPERWD)
                                                  DIV ELSPERWD
                             ELSE
                               LSIZE := LSIZE*(LMAX - LMIN + 1);
                             IF LSIZE <= 0 THEN
                               BEGIN ERROR(398); LSIZE := 1 END;
                             SIZE := LSIZE
                           END
                       END;
                     LSP := LSP1; LSP1 := LSP2
                   UNTIL LSP1 = NIL
                 END
               ELSE
   (*RECORD*)    IF SY = RECORDSY THEN
                   BEGIN INSYMBOL;
                     OLDTOP := TOP;
                     IF TOP < DISPLIMIT THEN
                       BEGIN TOP := TOP + 1;
                         WITH DISPLAY[TOP] DO
                           BEGIN FNAME := NIL; OCCUR := REC END
                       END
                     ELSE ERROR(250);
                     DISPL := 0; NEXTBIT := 0;
                     FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1);
                     DISPL := DISPL + ORD(NEXTBIT > 0);
                     NEW(LSP,RECORDS);
                     WITH LSP^ DO
                       BEGIN FSTFLD := DISPLAY[TOP].FNAME;
                         RECVAR := LSP1; SIZE := DISPL;
                         FORM := RECORDS
                       END;
                     TOP := OLDTOP;
                     IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
                   END
                 ELSE
   (*SET*)         IF SY = SETSY THEN
                     BEGIN INSYMBOL;
                       IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
                       SIMPLETYPE(FSYS,LSP1,LSIZE);
                       IF LSP1 <> NIL THEN
                         IF (LSP1^.FORM > SUBRANGE) OR
                                 (LSP1 = INTPTR) OR (LSP1 = REALPTR) THEN
                           BEGIN ERROR(115); LSP1 := NIL END
                         ELSE
                           IF LSP1 = REALPTR THEN
                             BEGIN ERROR(114); LSP1 := NIL END;
                       NEW(LSP,POWER);
                       WITH LSP^ DO
                         BEGIN ELSET := LSP1; FORM := POWER;
                           IF LSP1 <> NIL THEN
                             BEGIN GETBOUNDS(LSP1,LMIN,LMAX);
                               SIZE := (LMAX + BITSPERWD) DIV BITSPERWD;
                               IF SIZE > 255 THEN
                                 BEGIN ERROR(169); SIZE := 1 END
                             END
                           ELSE SIZE := 0
                         END
                     END
                   ELSE
   (*FILE*)          IF SY = FILESY THEN
                       BEGIN
                         IF INMODULE THEN
                           IF NOT ININTERFACE THEN
                             ERROR(191); (*NO PRIVATE FILES*)
                         INSYMBOL; NEW(LSP,FILES);
                         WITH LSP^ DO
                           BEGIN FORM := FILES; FILTYPE := NIL END;
                         IF SY = OFSY THEN
                           BEGIN INSYMBOL; TYP(FSYS,LSP1,LSIZE) END
                         ELSE LSP1 := NIL;
                         LSP^.FILTYPE := LSP1;
                         IF LSP1 <> NIL THEN
                           LSP^.SIZE := FILESIZE + LSP1^.SIZE
                         ELSE LSP^.SIZE := NILFILESIZE
                       END;
               FSP := LSP
             END;
         IF NOT (SY IN FSYS) THEN
           BEGIN ERROR(6); SKIP(FSYS) END
       END
     ELSE FSP := NIL;
     IF FSP = NIL THEN FSIZE := 1 ELSE FSIZE := FSP^.SIZE
   END (*TYP*) ;
			
 (* $I DECPART.B.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

     PROCEDURE USESDECLARATION(MAGIC: BOOLEAN);
       LABEL 1;
       TYPE DCREC = RECORD
                      DISKADDR: INTEGER;
                      CODELENG: INTEGER
                    END;
       VAR SEGDICT: RECORD
                        DANDC: ARRAY[SEGRANGE] OF DCREC;
                        SEGNAME: ARRAY[SEGRANGE] OF ALPHA;
                        SEGKIND: ARRAY[SEGRANGE] OF INTEGER;
                        TEXTADDR: ARRAY[SEGRANGE] OF INTEGER;
                        FILLER: ARRAY[0..127] OF INTEGER
                    END;
           FOUND: BOOLEAN; BEGADDR: INTEGER;
           LCP: CTP; LLEXSTK: LEXSTKREC; LNAME: ALPHA;
           LSY: SYMBOL; LOP: OPERATOR; LID: ALPHA;

       PROCEDURE GETTEXT(VAR FOUND: BOOLEAN);
         VAR LCP: CTP; SEGINDEX: INTEGER;

       BEGIN FOUND := FALSE;
         LCP := MODPTR;
         WHILE (LCP <> NIL) AND NOT FOUND DO
           IF LCP^.NAME = ID THEN FOUND := TRUE ELSE LCP := LCP^.NEXT;
         IF FOUND THEN
           BEGIN
             LSEPPROC := SEGTABLE[LCP^.SEGID].SEGKIND = 4;
             IF NOT LSEPPROC THEN
               BEGIN SEG := LCP^.SEGID; NEXTPROC := 1 END;
             BEGADDR := SEGTABLE[LCP^.SEGID].TEXTADDR;
             USEFILE := WORKCODE;
           END
         ELSE
           BEGIN FOUND := TRUE;
             IF LIBNOTOPEN THEN
               BEGIN RESET(LIBRARY,SYSTEMLIB);
                 IF IORESULT <> 0 THEN BEGIN ERROR(187); FOUND := FALSE END
                 ELSE
                   IF BLOCKREAD(LIBRARY,SEGDICT,1,0) <> 1 THEN
                     BEGIN ERROR(187); FOUND := FALSE END;
               END;
             IF FOUND THEN
               BEGIN LIBNOTOPEN := FALSE;
                 SEGINDEX := 0; FOUND := FALSE;
                 WHILE (SEGINDEX <= MAXSEG) AND (NOT FOUND) DO
                   IF MAGIC THEN
                       IF SEGDICT.SEGNAME[SEGINDEX] = LNAME THEN FOUND := TRUE
                       ELSE SEGINDEX := SEGINDEX + 1
                   ELSE
                     IF SEGDICT.SEGNAME[SEGINDEX] = ID THEN FOUND := TRUE
                     ELSE SEGINDEX := SEGINDEX + 1;
                 IF FOUND THEN
                   BEGIN USEFILE := SYSLIBRARY;
                     BEGADDR := SEGDICT.TEXTADDR[SEGINDEX];
                     LSEPPROC := SEGDICT.SEGKIND[SEGINDEX] = 4;
                     IF NOT LSEPPROC THEN
                       BEGIN
                         IF MAGIC THEN SEG := 6
                         ELSE
                           BEGIN SEG := NEXTSEG;
                             NEXTSEG := NEXTSEG + 1;
                             IF NEXTSEG > MAXSEG THEN ERROR(250)
                           END;
                         WITH SEGTABLE[SEG] DO
                           BEGIN DISKADDR := 0; CODELENG := 0;
                             SEGNAME := SEGDICT.SEGNAME[SEGINDEX];
                             IF INMODULE OR MAGIC THEN SEGKIND := 0
                             ELSE SEGKIND := SEGDICT.SEGKIND[SEGINDEX];
                             TEXTADDR := 0
                           END;
                         NEXTPROC := 1
                       END
                   END
                 ELSE ERROR(190) (*NOT IN LIBRARY*)
               END
           END;
         IF BEGADDR = 0 THEN BEGIN ERROR(195); FOUND := FALSE END;
         IF FOUND THEN
           BEGIN
             USING := TRUE;
             PREVSYMCURSOR := SYMCURSOR;
             PREVLINESTART := LINESTART;
             PREVSYMBLK := SYMBLK - 2;
             SYMBLK := BEGADDR; GETNEXTPAGE;
             INSYMBOL
           END
       END (*GETTEXT*) ;

     BEGIN (*USESDECLARATION*)
       IF LEVEL <> 1 THEN ERROR(189);
       IF INMODULE AND NOT ININTERFACE THEN ERROR(192);
       IF NOT MAGIC THEN DLINKERINFO := TRUE;
       IF NOT USING THEN USINGLIST := NIL;
       REPEAT
         IF (NOT MAGIC) AND (SY <> IDENT) THEN ERROR(2)
         ELSE
           IF USING THEN
             BEGIN LCP := USINGLIST;
               WHILE LCP <> NIL DO
                 IF LCP^.NAME = ID THEN GOTO 1
                 ELSE LCP := LCP^.NEXT;
               ERROR(188)(*UNIT MUST BE PREDECLARED IN MAIN PROG*);
           1:
             END
           ELSE
             BEGIN
               IF MAGIC THEN
                 BEGIN LNAME := 'TURTLE  ';
                   LSY := SY; LOP := OP; LID := ID
                 END
               ELSE
                 BEGIN LNAME := ID;
                   WRITELN(OUTPUT); WRITELN(OUTPUT,ID,' [',MEMAVAIL:5,' words]');
                   WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
                 END;
               WITH LLEXSTK DO
                 BEGIN DOLDSEG := SEG; SOLDPROC := NEXTPROC END;
               GETTEXT(FOUND);
               IF FOUND THEN
                 BEGIN
                   NEW(LCP,MODULE);
                   WITH LCP^ DO
                     BEGIN NAME := LNAME; NEXT := USINGLIST;
                       IDTYPE := NIL; KLASS := MODULE;
                       IF LSEPPROC THEN SEGID := -1 (*NO SEG*) ELSE SEGID := SEG
                     END;
                   ENTERID(LCP);
                   USINGLIST := LCP;
                   DECLARATIONPART(FSYS + [ENDSY]);
                   IF NEXTPROC=1 (*NO PROCS DECLARED*) THEN
                     LCP^.SEGID := -1; (*NO SEG*)
                   SYMBLK := 9999; (*FORCE RETURN TO SOURCEFILE*)
                   GETNEXTPAGE
                 END;
               IF NOT LSEPPROC THEN
                 WITH LLEXSTK DO
                   BEGIN SEG := DOLDSEG;
                     NEXTPROC := SOLDPROC
                   END;
               LSEPPROC := FALSE;
             END;
         IF NOT MAGIC THEN
           BEGIN INSYMBOL;
             TEST := SY <> COMMA;
             IF TEST THEN
               IF SY <> SEMICOLON THEN ERROR(20)
               ELSE
             ELSE INSYMBOL
           END
       UNTIL TEST OR MAGIC;
       IF NOT MAGIC THEN
         IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
       ELSE BEGIN SY := LSY; OP := LOP; ID := LID END;
       IF NOT USING THEN
         BEGIN
           IF INMODULE THEN USINGLIST := NIL;
           CLOSE(LIBRARY,LOCK);
           LIBNOTOPEN := TRUE
         END
     END (*USESDECLARATION*) ;

     PROCEDURE LABELDECLARATION;
       VAR LLP: LABELP; REDEF: BOOLEAN;
     BEGIN
       REPEAT
         IF SY = INTCONST THEN
           WITH DISPLAY[TOP] DO
             BEGIN LLP := FLABEL; REDEF := FALSE;
               WHILE (LLP <> NIL) AND NOT REDEF DO
                 IF LLP^.LABVAL <> VAL.IVAL THEN
                   LLP := LLP^.NEXTLAB
                 ELSE BEGIN REDEF := TRUE; ERROR(166) END;
               IF NOT REDEF THEN
                 BEGIN NEW(LLP);
                   WITH LLP^ DO
                     BEGIN LABVAL := VAL.IVAL;
                       CODELBP := NIL; NEXTLAB := FLABEL
                     END;
                   FLABEL := LLP
                 END;
               INSYMBOL
             END
         ELSE ERROR(15);
         IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN
           BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END;
         TEST := SY <> COMMA;
         IF NOT TEST THEN INSYMBOL
       UNTIL TEST;
       IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
     END (* LABELDECLARATION *) ;

     PROCEDURE CONSTDECLARATION;
       VAR LCP: CTP; LSP: STP; LVALU: VALU;
     BEGIN
       IF SY <> IDENT THEN
         BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
       WHILE SY = IDENT DO
         BEGIN NEW(LCP,KONST);
           WITH LCP^ DO
             BEGIN NAME := ID; IDTYPE := NIL;
               NEXT := NIL; KLASS := KONST
             END;
           INSYMBOL;
           IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
           CONSTANT(FSYS + [SEMICOLON],LSP,LVALU);
           ENTERID(LCP);
           LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU;
           IF SY = SEMICOLON THEN
             BEGIN INSYMBOL;
               IF NOT (SY IN FSYS + [IDENT]) THEN
                 BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
             END
           ELSE
             IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14)
         END
     END (*CONSTDECLARATION*) ;

     PROCEDURE TYPEDECLARATION;
       VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE;
     BEGIN
       IF SY <> IDENT THEN
         BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
       WHILE SY = IDENT DO
         BEGIN NEW(LCP,TYPES);
           WITH LCP^ DO
             BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END;
           INSYMBOL;
           IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
           TYP(FSYS + [SEMICOLON],LSP,LSIZE);
           ENTERID(LCP);
           LCP^.IDTYPE := LSP;
           LCP1 := FWPTR;
           WHILE LCP1 <> NIL DO
             BEGIN
               IF LCP1^.NAME = LCP^.NAME THEN
                 BEGIN
                   LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE;
                   IF LCP1 <> FWPTR THEN
                     LCP2^.NEXT := LCP1^.NEXT
                   ELSE FWPTR := LCP1^.NEXT;
                 END;
               LCP2 := LCP1; LCP1 := LCP1^.NEXT
             END;
           IF SY = SEMICOLON THEN
             BEGIN INSYMBOL;
               IF NOT (SY IN FSYS + [IDENT]) THEN
                 BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
             END
           ELSE
             IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14)
         END;
       IF FWPTR <> NIL THEN
         BEGIN ERROR(117); FWPTR := NIL END
     END (*TYPEDECLARATION*) ;

     PROCEDURE VARDECLARATION;
       VAR LCP,NXT,IDLIST: CTP; LSP: STP; LSIZE: ADDRRANGE;
     BEGIN NXT := NIL;
       REPEAT
         REPEAT
           IF SY = IDENT THEN
             BEGIN
               IF INMODULE THEN NEW(LCP,ACTUALVARS,TRUE)
               ELSE NEW(LCP,ACTUALVARS,FALSE);
               WITH LCP^ DO
                BEGIN NAME := ID; NEXT := NXT; KLASS := ACTUALVARS;
                  IDTYPE := NIL; VLEV := LEVEL;
                  IF INMODULE THEN
                    IF ININTERFACE THEN PUBLIC := TRUE
                    ELSE PUBLIC := FALSE
                END;
               ENTERID(LCP);
               NXT := LCP;
               INSYMBOL;
             END
           ELSE ERROR(2);
           IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN
             BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END;
           TEST := SY <> COMMA;
           IF NOT TEST THEN INSYMBOL
         UNTIL TEST;
         IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
         IDLIST := NXT;
         TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE);
         WHILE NXT <> NIL DO
           WITH  NXT^ DO
             BEGIN IDTYPE := LSP; VADDR := LC;
               LC := LC + LSIZE; NXT := NEXT;
               IF NEXT = NIL THEN
                 IF LSP <> NIL THEN
                   IF LSP^.FORM = FILES THEN
                       BEGIN (*PUT IDLIST INTO LOCAL FILE LIST*)
                         NEXT := DISPLAY[TOP].FFILE;
                         DISPLAY[TOP].FFILE := IDLIST
                       END
             END;
         IF SY = SEMICOLON THEN
           BEGIN INSYMBOL;
             IF NOT (SY IN FSYS + [IDENT]) THEN
               BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
           END
         ELSE
             IF NOT ((SY = ENDSY) AND (INMODULE)) THEN ERROR(14)
       UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS);
     IF FWPTR <> NIL THEN
         BEGIN ERROR(117); FWPTR := NIL END
     END (*VARDECLARATION*) ;

 (* $I DECPART.C.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

     PROCEDURE PROCDECLARATION(FSY: SYMBOL; SEGDEC: BOOLEAN);
       VAR LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP;
           EXTONLY,FORW: BOOLEAN;
           LCM: ADDRRANGE;
           LLEXSTK: LEXSTKREC;

       PROCEDURE PARAMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP; FCP: CTP);
         VAR LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND;
           LLC,LEN : ADDRRANGE; COUNT : INTEGER;
       BEGIN LCP1 := NIL; LLC := LC;
         IF NOT (SY IN FSY + [LPARENT]) THEN
           BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END;
         IF SY = LPARENT THEN
           BEGIN IF FORW THEN ERROR(119);
             INSYMBOL;
             IF NOT (SY IN [IDENT,VARSY]) THEN
               BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END;
             WHILE SY IN [IDENT,VARSY] DO
               BEGIN
                 IF SY = VARSY THEN
                   BEGIN LKIND := FORMAL; INSYMBOL END
                 ELSE LKIND := ACTUAL;
                 LCP2 := NIL;
                 COUNT := 0;
                 REPEAT
                   IF SY <> IDENT THEN ERROR(2)
                   ELSE
                     BEGIN
                       NEW(LCP,FORMALVARS,FALSE); (*MAY BE ACTUAL(SAME SIZE)*)
                       WITH LCP^ DO
                         BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2;
                           IF LKIND = FORMAL THEN KLASS := FORMALVARS
                           ELSE KLASS := ACTUALVARS; VLEV := LEVEL
                         END;
                       ENTERID(LCP);
                       LCP2 := LCP; COUNT := COUNT + 1;
                       INSYMBOL
                     END;
                   IF NOT (SY IN FSYS + [COMMA,SEMICOLON,COLON]) THEN
                     BEGIN ERROR(7);
                       SKIP(FSYS + [COMMA,SEMICOLON,RPARENT,COLON])
                     END;
                   TEST := SY <> COMMA;
                   IF NOT TEST THEN INSYMBOL
                 UNTIL TEST;
                 LSP := NIL;
                 IF SY = COLON THEN
                   BEGIN INSYMBOL;
                     IF SY = IDENT THEN
                       BEGIN
                         SEARCHID([TYPES],LCP);
                         INSYMBOL;
                         LSP := LCP^.IDTYPE;
                         LEN := PTRSIZE;
                         IF LSP <> NIL THEN
                           IF LKIND = ACTUAL THEN
                             IF LSP^.FORM = FILES THEN ERROR(121)
                             ELSE
                               IF LSP^.FORM <= POWER THEN LEN := LSP^.SIZE;
                         LC := LC + COUNT * LEN
                       END
                     ELSE ERROR(2)
                   END
                 ELSE
                   IF LKIND = FORMAL THEN
                     EXTONLY := TRUE
                   ELSE ERROR(5);
                 IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN
                   BEGIN ERROR(7); SKIP(FSYS + [SEMICOLON,RPARENT]) END;
                 LCP3 := LCP2; LCP := NIL;
                 WHILE LCP2 <> NIL DO
                   BEGIN LCP := LCP2;
                     WITH LCP2^ DO
                       BEGIN IDTYPE := LSP;
                         LCP2 := NEXT
                       END
                   END;
                 IF LCP <> NIL THEN
                   BEGIN LCP^.NEXT := LCP1; LCP1 := LCP3 END;
                 IF SY = SEMICOLON THEN
                   BEGIN INSYMBOL;
                     IF NOT (SY IN FSYS + [IDENT,VARSY]) THEN
                       BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END
                   END
               END (*WHILE*) ;
             IF SY = RPARENT THEN
               BEGIN INSYMBOL;
                 IF NOT (SY IN FSY + FSYS) THEN
                   BEGIN ERROR(6); SKIP(FSY + FSYS) END
               END
             ELSE ERROR(4);
             FCP^.LOCALLC := LC; LCP3 := NIL;
             WHILE LCP1 <> NIL DO
               WITH LCP1^ DO
                 BEGIN LCP2 := NEXT; NEXT := LCP3;
                   IF (IDTYPE <> NIL) THEN
                     IF KLASS = FORMALVARS THEN
                       BEGIN VADDR := LLC; LLC := LLC + PTRSIZE END
                     ELSE
                       IF KLASS = ACTUALVARS THEN
                         IF (IDTYPE^.FORM <= POWER) THEN
                           BEGIN VADDR := LLC; LLC := LLC + IDTYPE^.SIZE END
                         ELSE
                           BEGIN VADDR := LC;
                             LC := LC + IDTYPE^.SIZE;
                             LLC := LLC + PTRSIZE
                           END;
                   LCP3 := LCP1; LCP1 := LCP2
                 END;
             FPAR := LCP3
           END
             ELSE FPAR := NIL
     END (*PARAMETERLIST*) ;

     BEGIN (*PROCDECLARATION*)
       IF SEGDEC THEN (* SEGMENT DECLARATION *)
         BEGIN
           IF CODEINSEG THEN
             BEGIN ERROR(399); SEGINX:=0; CURBYTE:=0; END;
           WITH LLEXSTK DO
             BEGIN
               DOLDSEG:=SEG;
               SEG:=NEXTSEG;
               SOLDPROC:=NEXTPROC;
             END;
           NEXTPROC:=1;
           LSY:=SY;
           IF SY IN [PROCSY,FUNCSY] THEN INSYMBOL
           ELSE BEGIN ERROR(399); LSY:=PROCSY END;
           FSY:=LSY;
         END;
       LLEXSTK.DLLC := LC; LC := LCAFTERMARKSTACK;
       IF FSY = FUNCSY THEN LC := LC + REALSIZE;
       LINEINFO := LC; DP := TRUE; EXTONLY := FALSE;
       IF SY = IDENT THEN
         BEGIN
           IF USING OR INMODULE AND ININTERFACE THEN FORW := FALSE
           ELSE
             BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP);
               IF LCP <> NIL THEN
                 BEGIN
                   IF LCP^.KLASS = PROC THEN
                     FORW := LCP^.FORWDECL AND (FSY = PROCSY)
                             AND (LCP^.PFKIND = ACTUAL)
                   ELSE
                     IF LCP^.KLASS = FUNC THEN
                       FORW := LCP^.FORWDECL AND (FSY = FUNCSY)
                               AND (LCP^.PFKIND = ACTUAL)
                     ELSE FORW := FALSE;
                   IF NOT FORW THEN ERROR(160)
                 END
               ELSE FORW := FALSE
             END;
           IF NOT FORW THEN
             BEGIN
               IF FSY = PROCSY THEN
                 IF INMODULE THEN NEW(LCP,PROC,DECLARED,ACTUAL,TRUE)
                 ELSE NEW(LCP,PROC,DECLARED,ACTUAL,FALSE)
               ELSE
                 IF INMODULE THEN NEW(LCP,FUNC,DECLARED,ACTUAL,TRUE)
                 ELSE NEW(LCP,FUNC,DECLARED,ACTUAL,FALSE);
               WITH LCP^ DO
                 BEGIN NAME := ID; IDTYPE := NIL; LOCALLC := LC;
                   PFDECKIND := DECLARED; PFKIND := ACTUAL;
                   INSCOPE := FALSE; PFLEV := LEVEL;
                   PFNAME := NEXTPROC; PFSEG := SEG;
                   IF USING THEN PROCTABLE[NEXTPROC] := 0;
                   IF INMODULE THEN
                     IF USING THEN IMPORTED := TRUE
                     ELSE IMPORTED := FALSE;
                   IF SEGDEC THEN
                     BEGIN
                       IF NEXTSEG > MAXSEG THEN ERROR(250);
                       NEXTSEG := NEXTSEG+1;
                       SEGTABLE[SEG].SEGNAME := ID
                     END;
                   IF NEXTPROC = MAXPROCNUM THEN ERROR(251)
                   ELSE NEXTPROC := NEXTPROC + 1;
                   IF FSY = PROCSY THEN KLASS := PROC
                   ELSE KLASS := FUNC
                 END;
               ENTERID(LCP)
             END
           ELSE
             BEGIN LCP1 := LCP^.NEXT;
               WHILE LCP1 <> NIL DO
                 BEGIN
                   WITH LCP1^ DO
                     IF IDTYPE = NIL THEN
                       EXTONLY := TRUE
                     ELSE
                       IF KLASS = FORMALVARS THEN
                         BEGIN
                           LCM := VADDR + PTRSIZE;
                           IF LCM > LC THEN LC := LCM
                         END
                       ELSE
                         IF KLASS = ACTUALVARS THEN
                           BEGIN
                             LCM := VADDR + IDTYPE^.SIZE;
                             IF LCM > LC THEN LC := LCM
                           END;
                   LCP1 := LCP1^.NEXT
                 END;
               IF SEG <> LCP^.PFSEG THEN
                 BEGIN
                   SEG := LCP^.PFSEG; NEXTPROC := 2;
                   IF NOT SEGDEC THEN ERROR(399)
                 END
             END;
           INSYMBOL
         END
       ELSE
         BEGIN ERROR(2); LCP := UPRCPTR END;
       WITH LLEXSTK DO
         BEGIN DOLDLEV:=LEVEL;
           DOLDTOP:=TOP;
           POLDPROC:=CURPROC;
           DFPROCP:=LCP;
         END;
       CURPROC := LCP^.PFNAME;
       IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251);
       IF TOP < DISPLIMIT THEN
         BEGIN TOP := TOP + 1;
           WITH DISPLAY[TOP] DO
             BEGIN
               IF FORW THEN FNAME := LCP^.NEXT
               ELSE FNAME := NIL;
               FLABEL := NIL; FFILE := NIL; OCCUR := BLCK
             END
         END
       ELSE ERROR(250);
       IF FSY = PROCSY THEN
         BEGIN PARAMETERLIST([SEMICOLON],LCP1,LCP);
           IF NOT FORW THEN LCP^.NEXT := LCP1
         END
       ELSE
         BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1,LCP);
           IF NOT FORW THEN LCP^.NEXT := LCP1;
           IF SY = COLON THEN
             BEGIN INSYMBOL;
               IF SY = IDENT THEN
                 BEGIN IF FORW THEN ERROR(122);
                   SEARCHID([TYPES],LCP1);
                   LSP := LCP1^.IDTYPE;
                   LCP^.IDTYPE := LSP;
                   IF LSP <> NIL THEN
                     IF NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN
                       BEGIN ERROR(120); LCP^.IDTYPE := NIL END;
                   INSYMBOL
                 END
               ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END
             END
           ELSE
             IF NOT FORW THEN ERROR(123)
         END;
       IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
       LCP^.EXTURNAL := FALSE;
       IF (SY = EXTERNLSY)
          OR ((USING) AND (LSEPPROC)) THEN
         BEGIN
           IF LEVEL <> 2 THEN
             ERROR(183) (*EXTERNAL PROCS MUST BE IN OUTERMOST BLOCK*);
           IF INMODULE THEN
             IF ININTERFACE AND NOT USING THEN
               ERROR(184); (*NO EXTERNAL DECL IN INTERFACE*)
           IF SEGDEC THEN ERROR(399);
           WITH LCP^ DO
             BEGIN EXTURNAL := TRUE; FORWDECL := FALSE;
               WRITELN(OUTPUT); WRITELN(OUTPUT,NAME,' [',MEMAVAIL:5,' words]');
               WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
             END;
           PROCTABLE[CURPROC] := 0;
           DLINKERINFO := TRUE;
           IF SY = EXTERNLSY THEN
             BEGIN INSYMBOL;
               IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
               IF NOT (SY IN FSYS) THEN
                 BEGIN ERROR(6); SKIP(FSYS) END
             END
         END
       ELSE
         IF USING THEN
           BEGIN LCP^.FORWDECL := FALSE;
           END
         ELSE
           IF (SY = FORWARDSY) OR INMODULE AND ININTERFACE THEN
             BEGIN
               IF FORW THEN ERROR(161)
               ELSE LCP^.FORWDECL := TRUE;
               IF SY = FORWARDSY THEN
                 BEGIN INSYMBOL;
                   IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
                 END;
               IF NOT (SY IN FSYS) THEN
                 BEGIN ERROR(6); SKIP(FSYS) END
             END
           ELSE
             BEGIN
               IF EXTONLY THEN
                 ERROR(7);
               NEWBLOCK:=TRUE;
               NOTDONE:=TRUE;
               WITH LLEXSTK DO
                 BEGIN
                   MARK(DMARKP);
                   WITH LCP^ DO
                     BEGIN FORWDECL := FALSE; INSCOPE := TRUE;
                       EXTURNAL := FALSE END;
                   BFSY:=SEMICOLON;
                   ISSEGMENT:=SEGDEC;
                   PREVLEXSTACKP:=TOS;
                  END;
               NEW(TOS);
               TOS^:=LLEXSTK;
               EXIT(PROCDECLARATION);
             END;
       WITH LLEXSTK DO  (* FORWARD OR EXTERNAL DECLARATION, SO RESTORE STATE *)
         BEGIN
           LEVEL:=DOLDLEV;
           TOP:=DOLDTOP;
           LC:=DLLC;
           CURPROC:=POLDPROC;
           IF SEGDEC THEN
             BEGIN
               NEXTPROC:=SOLDPROC;
               SEG:=DOLDSEG;
             END;
         END;
      END; (* PROCDECLARATION *)


   BEGIN (*DECLARATIONPART*)
     IF (NOSWAP) AND (STARTINGUP) THEN
       BEGIN
         STARTINGUP:=FALSE; (* ALL SEGMENTS ARE IN BY THIS TIME *)
         BLOCK(FSYS);
         EXIT(DECLARATIONPART);
       END;
     IF NOISY THEN
       UNITWRITE(3,DUMMYVAR[-1600],35); (*ADJUST DISPLAY OF STACK AND HEAP*)
     REPEAT
       NOTDONE:=FALSE;
       IF USERINFO.STUPID THEN
         IF NOT CODEINSEG THEN
           IF (LEVEL = 1) AND (NEXTSEG = 10) THEN
             IF NOT(INMODULE OR USING) THEN USESDECLARATION(TRUE);
             (*To get turtle graphics*)
       IF SY = USESSY THEN
         BEGIN INSYMBOL; USESDECLARATION(FALSE) END;
       IF SY = LABELSY THEN
         BEGIN
           IF INMODULE AND ININTERFACE THEN
             BEGIN ERROR(186); SKIP(FSYS - [LABELSY]) END
           ELSE INSYMBOL; LABELDECLARATION END;
       IF SY = CONSTSY THEN
         BEGIN INSYMBOL; CONSTDECLARATION END;
       IF SY = TYPESY THEN
         BEGIN INSYMBOL; TYPEDECLARATION END;
       IF SY = VARSY THEN
         BEGIN INSYMBOL; VARDECLARATION END;
       IF LEVEL = 1 THEN GLEV := TOP;
       IF SY IN [PROCSY,FUNCSY,PROGSY] THEN
         BEGIN
           IF INMODULE THEN
             IF ININTERFACE AND NOT USING THEN PUBLICPROCS := TRUE;
           REPEAT
             LSY := SY; INSYMBOL;
             IF LSY = PROGSY THEN
               IF INMODULE THEN
                 BEGIN ERROR(185 (*SEG DEC NOT ALLOWED IN UNIT*));
                   PROCDECLARATION(PROCSY,FALSE)
                 END
               ELSE PROCDECLARATION(LSY,TRUE)
             ELSE PROCDECLARATION(LSY,FALSE);
           UNTIL NOT (SY IN [PROCSY,FUNCSY,PROGSY])
         END;
       IF (SY <> BEGINSY) THEN
        IF NOT ((USING OR INMODULE) AND (SY IN [IMPLESY,ENDSY]))
           AND NOT( SY IN [SEPARATSY,UNITSY]) THEN
          IF (NOT (INCLUDING OR NOTDONE))
             OR
             NOT(SY IN BLOCKBEGSYS) THEN
            BEGIN ERROR(18); SKIP(FSYS - [UNITSY,INTERSY]); END;
     UNTIL (SY IN (STATBEGSYS + [SEPARATSY,UNITSY,IMPLESY,ENDSY]));
     NEWBLOCK:=FALSE;
   END (*DECLARATIONPART*) ;

 (* $I BODYPART.A.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

 SEGMENT PROCEDURE BODYPART(FSYS: SETOFSYS; FPROCP: CTP);

   PROCEDURE LINKERREF(KLASS: IDCLASS; ID,ADDR: INTEGER);
   BEGIN
     IF NREFS > REFSPERBLK THEN (*WRITE BUFFER*)
       BEGIN
         IF BLOCKWRITE(REFFILE,REFLIST^,1,REFBLK) <> 1 THEN ERROR(402);
         REFBLK := REFBLK + 1;
         NREFS := 1
       END;
     WITH REFLIST^[NREFS] DO
       BEGIN
         IF KLASS IN VARS THEN KEY := ID + 32
         ELSE (*PROC*) KEY := ID;
         OFFSET := SEGINX + ADDR
       END;
     NREFS := NREFS + 1
   END (*LINKERREF*) ;

   PROCEDURE GENLDC(IVAL: INTEGER);
   BEGIN
     IF (IVAL >= 0) AND (IVAL <= 127) THEN GENBYTE(IVAL)
     ELSE
       BEGIN GENBYTE(51(*LDC*)+148);
         MOVELEFT(IVAL,CODEP^[IC],2);
         IC := IC+2
       END
   END (*GENLDC*) ;

   PROCEDURE GENBIG(IVAL: INTEGER);
     VAR LOWORDER: CHAR;
   BEGIN
     IF IVAL <= 127 THEN GENBYTE(IVAL)
     ELSE
       BEGIN MOVELEFT(IVAL,CODEP^[IC],2); LOWORDER := CODEP^[IC];
         CODEP^[IC] := CHR(ORD(CODEP^[IC+1])+128);
         CODEP^[IC+1] := LOWORDER; IC := IC+2
       END
   END (*GENBIG*) ;

   PROCEDURE GEN0(FOP: OPRANGE);
     VAR I: INTEGER;
   BEGIN
     GENBYTE(FOP+128);
     IF FOP = 38(*LCA*) THEN
       WITH GATTR.CVAL.VALP^ DO
         BEGIN GENBYTE(SLGTH);
           FOR I := 1 TO SLGTH DO GENBYTE(ORD(SVAL[I]))
         END
   END (*GEN0*) ;

   PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER);
     LABEL 1;
     VAR I,J: INTEGER;
   BEGIN
     GENBYTE(FOP+128);
     IF FOP = 51(*LDC*) THEN
       BEGIN
         IF FP2 = 2 THEN I := REALSIZE
         ELSE
           BEGIN I := 8;
             WHILE I > 0 DO
               IF GATTR.CVAL.VALP^.CSTVAL[I] <> 0 THEN GOTO 1
               ELSE I := I - 1;
       1:  END;
         GATTR.TYPTR^.SIZE := I;
         IF I > 1 THEN
           BEGIN GENBYTE(I);
             FOR J := I DOWNTO 1 DO GENWORD(GATTR.CVAL.VALP^.CSTVAL[J])
           END
         ELSE
           BEGIN IC := IC - 1;
             IF I = 1 THEN GENLDC(GATTR.CVAL.VALP^.CSTVAL[1])
           END
       END
     ELSE
       IF FOP IN [30(*CSP*),32(*ADJ*),45(*RNP*),
                  46(*CIP*),60(*LDM*),61(*STM*),
                  65(*RBP*),66(*CBP*),78(*CLP*),
                  42(*SAS*),79(*CGP*)] THEN GENBYTE(FP2)
       ELSE
         IF INMODULE AND (FOP IN [37(*LAO*),39(*LDO*),43(*SRO*)]) THEN
           BEGIN LINKERREF(ACTUALVARS,FP2,IC); GENBYTE(128); GENBYTE(0) END
         ELSE
           IF ((FOP = 74(*LDL*)) OR (FOP = 39(*LDO*)))
               AND (FP2 <= 16) THEN
             BEGIN IC := IC-1;
               IF FOP = 39(*LDO*) THEN GENBYTE(231+FP2)
               ELSE GENBYTE(215+FP2)
             END
           ELSE
             IF (FOP = 35(*IND*)) AND (FP2 <= 7) THEN
               BEGIN IC := IC-1; GENBYTE(248+FP2) END
             ELSE
               GENBIG(FP2)
   END (*GEN1*) ;

   PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER);
   BEGIN
     IF (FOP = 64(*IXP*)) OR (FOP = 77(*CXP*)) THEN
       BEGIN GENBYTE(FOP+128); GENBYTE(FP1); GENBYTE(FP2);
       END
     ELSE
       IF FOP IN [47(*EQU*),48(*GEQ*),49(*GRT*),
                  52(*LEQ*),53(*LES*),55(*NEQ*)] THEN
         IF FP1 = 0 THEN GEN0(FOP+20)
         ELSE
           BEGIN GEN1(FOP,FP1+FP1);
             IF FP1 > 4 THEN GENBIG(FP2)
           END
       ELSE
         BEGIN (*LDA,LOD,STR*)
           IF FP1 = 0 THEN GEN1(FOP+20,FP2)
           ELSE
             BEGIN
               GENBYTE(FOP+128); GENBYTE(FP1); GENBIG(FP2)
             END
         END;
   END (*GEN2*) ;

   PROCEDURE GENNR(EXTPROC: NONRESIDENT);

    PROCEDURE ASSIGN(EXTPROC: NONRESIDENT);
    BEGIN
      PROCTABLE[NEXTPROC] := 0;
      PFNUMOF[EXTPROC] := NEXTPROC; NEXTPROC := NEXTPROC + 1;
      IF NEXTPROC > MAXPROCNUM THEN ERROR(193);(*NOT ENOUGH ROOM FOR THIS*)
      CLINKERINFO := TRUE                                  (*OPERATION*)
    END (*ASSIGN*) ;

   BEGIN (*GENNR*)
     IF PFNUMOF[EXTPROC] = 0 THEN ASSIGN(EXTPROC);
     IF SEPPROC THEN
       BEGIN
         GEN1(79(*CGP*),0); LINKERREF(PROC,-PFNUMOF[EXTPROC],IC-1)
       END
     ELSE
       GEN1(79(*CGP*),PFNUMOF[EXTPROC]);
   END (*GENNR*) ;

   PROCEDURE GENJMP(FOP: OPRANGE; FLBP: LBP);
     VAR DISP: INTEGER;
   BEGIN
     WITH FLBP^ DO
       IF DEFINED THEN
         BEGIN
           GENBYTE(FOP+128);
           DISP := OCCURIC-IC-1;
           IF (DISP >= 0) AND (DISP <= 127) THEN GENBYTE(DISP)
           ELSE
             BEGIN
               IF JTABINX = 0 THEN
                 BEGIN JTABINX := NEXTJTAB;
                   IF NEXTJTAB = MAXJTAB THEN ERROR(253)
                   ELSE NEXTJTAB := NEXTJTAB + 1;
                   JTAB[JTABINX] := OCCURIC
                 END;
               DISP := -JTABINX;
               GENBYTE(248-JTABINX-JTABINX)
             END;
         END
       ELSE
         BEGIN MOVELEFT(REFLIST,CODEP^[IC],2);
           IF FOP = 57(*UJP*) THEN DISP := IC + 4096
           ELSE DISP := IC;
           REFLIST := DISP; IC := IC+2
         END;
   END (*GENJMP*) ;

   PROCEDURE LOAD; FORWARD;

   PROCEDURE GENFJP(FLBP: LBP);
   BEGIN LOAD;
     IF GATTR.TYPTR <> BOOLPTR THEN ERROR(135);
     GENJMP(33(*FJP*),FLBP)
   END (*GENFJP*) ;

   PROCEDURE GENLABEL(VAR FLBP: LBP);
   BEGIN NEW(FLBP);
     WITH FLBP^ DO
       BEGIN DEFINED := FALSE; REFLIST := MAXADDR END
   END (*GENLABEL*) ;

   PROCEDURE PUTLABEL(FLBP: LBP);
     VAR LREF: INTEGER; LOP: OPRANGE;
   BEGIN
     WITH FLBP^ DO
       BEGIN LREF := REFLIST;
         DEFINED := TRUE; OCCURIC := IC; JTABINX := 0;
         WHILE LREF < MAXADDR DO
           BEGIN
             IF LREF >= 4096 THEN
               BEGIN LREF := LREF - 4096; LOP := 57(*UJP*) END
             ELSE LOP := 33(*FJP*);
             IC := LREF;
             MOVELEFT(CODEP^[IC],LREF,2);
             GENJMP(LOP,FLBP)
           END;
         IC := OCCURIC
       END
   END (*PUTLABEL*) ;

   PROCEDURE LOAD;
   VAR J,M: INTEGER;
   BEGIN
     WITH GATTR DO
       IF TYPTR <> NIL THEN
         BEGIN
           CASE KIND OF
             CST:   IF TYPTR^.FORM = LONGINT THEN
                      WITH GATTR.CVAL.VALP^ DO
                        BEGIN
                          M := 10000;
                          GENLDC(LONGVAL[1]); GENLDC(1);
                          FOR J := 2 TO LLENG DO
                            BEGIN
                              IF J = LLENG THEN M := TRUNC(PWROFTEN(LLAST));
                              GENLDC(M); GENLDC(1);
                              GENLDC(8(*DMP*)); GENNR(DECOPS);
                              GENLDC(LONGVAL[J]); GENLDC(1);
                              GENLDC(2(*DAD*)); GENNR(DECOPS)
                            END
                        END
                    ELSE
                      IF (TYPTR^.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN
                        GENLDC(CVAL.IVAL)
                      ELSE
                        IF TYPTR = NILPTR THEN GEN0(31(*LDCN*))
                        ELSE
                          IF TYPTR = REALPTR THEN GEN1(51(*LDC*),2)
                          ELSE GEN1(51(*LDC*),5);
             VARBL: CASE ACCESS OF
                      DRCT:   IF VLEVEL = 1 THEN GEN1(39(*LDO*),DPLMT)
                              ELSE GEN2(54(*LOD*),LEVEL-VLEVEL,DPLMT);
                      INDRCT: GEN1(35(*IND*),IDPLMT);
                      PACKD:  GEN0(58(*LDP*));
                      MULTI:  GEN1(60(*LDM*),TYPTR^.SIZE);
                      BYTE:   GEN0(62(*LDB*))
                    END;
             EXPR:
           END;
           WITH TYPTR^ DO
             IF ((FORM = POWER) OR
                (FORM = LONGINT) AND (KIND <> CST))
                AND (KIND <> EXPR) THEN GENLDC(TYPTR^.SIZE);
           KIND := EXPR
         END
   END (*LOAD*) ;

   PROCEDURE STORE(VAR FATTR: ATTR);
   BEGIN
     WITH FATTR DO
       IF TYPTR <> NIL THEN
         CASE ACCESS OF
           DRCT:   IF VLEVEL = 1 THEN GEN1(43(*SRO*),DPLMT)
                   ELSE GEN2(56(*STR*),LEVEL-VLEVEL,DPLMT);
           INDRCT: IF IDPLMT <> 0 THEN ERROR(400)
                   ELSE GEN0(26(*STO*));
           PACKD:  GEN0(59(*STP*));
           MULTI:  GEN1(61(*STM*),TYPTR^.SIZE);
           BYTE:   GEN0(63(*STB*))
         END
   END (*STORE*) ;

   PROCEDURE LOADADDRESS;
   BEGIN
     WITH GATTR DO
       IF TYPTR <> NIL THEN
         BEGIN
           CASE KIND OF
             CST:   IF STRGTYPE(TYPTR) THEN GEN0(38(*LCA*))
                    ELSE ERROR(400);
             VARBL: CASE ACCESS OF
                      DRCT:   IF VLEVEL = 1 THEN GEN1(37(*LAO*),DPLMT)
                              ELSE GEN2(50(*LDA*),LEVEL-VLEVEL,DPLMT);
                      INDRCT: IF IDPLMT <> 0 THEN GEN1(34(*INC*),IDPLMT+IDPLMT);
                      PACKD:  ERROR(103)
                    END
           END;
           KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0
         END
   END (*LOADADDRESS*) ;

   PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD;

   PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP);
     VAR LATTR: ATTR; LCP: CTP; LMIN,LMAX: INTEGER;
   BEGIN
     WITH FCP^, GATTR DO
       BEGIN TYPTR := IDTYPE; KIND := VARBL;
         CASE KLASS OF
           ACTUALVARS:
             BEGIN VLEVEL := VLEV; DPLMT := VADDR; ACCESS := DRCT;
               IF INMODULE THEN
                 IF TYPTR <> NIL THEN
                   IF (VLEV = 1) AND (TYPTR^.FORM = RECORDS) THEN LOADADDRESS
             END;
           FORMALVARS:
             BEGIN
               IF VLEV = 1 THEN GEN1(39(*LDO*),VADDR)
               ELSE GEN2(54(*LOD*),LEVEL-VLEV,VADDR);
               ACCESS := INDRCT; IDPLMT := 0
             END;
           FIELD:
             WITH DISPLAY[DISX] DO
              BEGIN
               IF OCCUR = CREC THEN
                 BEGIN ACCESS := DRCT; VLEVEL := CLEV;
                   DPLMT := CDSPL + FLDADDR
                 END
               ELSE
                 BEGIN
                   IF LEVEL = 1 THEN GEN1(39(*LDO*),VDSPL)
                   ELSE GEN2(54(*LOD*),0,VDSPL);
                   ACCESS := INDRCT; IDPLMT := FLDADDR
                 END;
               IF FISPACKD THEN
                 BEGIN LOADADDRESS;
                   IF ((FLDRBIT = 0) OR (FLDRBIT = 8))
                         AND (FLDWIDTH = 8) THEN
                     BEGIN ACCESS := BYTE;
                       IF FLDRBIT = 8 THEN GEN1(34(*INC*),1)
                     END
                   ELSE
                     BEGIN ACCESS := PACKD;
                       GENLDC(FLDWIDTH); GENLDC(FLDRBIT)
                     END
                 END
              END;
           FUNC:
             IF PFDECKIND <> DECLARED THEN ERROR(150)
             ELSE
               IF NOT INSCOPE THEN ERROR(103)
               ELSE
                   BEGIN ACCESS := DRCT; VLEVEL := PFLEV + 1;
                     DPLMT := LCAFTERMARKSTACK
                   END
         END (*CASE*);
         IF TYPTR <> NIL THEN
           IF (TYPTR^.FORM <= POWER) AND
              (TYPTR^.SIZE > PTRSIZE) THEN
             BEGIN LOADADDRESS; ACCESS := MULTI END
       END (*WITH*);
     IF NOT (SY IN SELECTSYS + FSYS) THEN
       BEGIN ERROR(59); SKIP(SELECTSYS + FSYS) END;
     WHILE SY IN SELECTSYS DO
       BEGIN
   (*[*) IF SY = LBRACK THEN
           BEGIN
             REPEAT LATTR := GATTR;
               WITH LATTR DO
                 IF TYPTR <> NIL THEN
                   IF TYPTR^.FORM <> ARRAYS THEN
                     BEGIN ERROR(138); TYPTR := NIL END;
               LOADADDRESS;
               INSYMBOL; EXPRESSION(FSYS + [COMMA,RBRACK]);
               LOAD;
               IF GATTR.TYPTR <> NIL THEN
                 IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(113);
               IF LATTR.TYPTR <> NIL THEN
                 WITH LATTR.TYPTR^ DO
                   BEGIN
                     IF COMPTYPES(INXTYPE,GATTR.TYPTR) THEN
                       BEGIN
                         IF (INXTYPE <> NIL) AND
                             NOT STRGTYPE(LATTR.TYPTR) THEN
                           BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                             IF RANGECHECK THEN
                               BEGIN GENLDC(LMIN); GENLDC(LMAX);
                                 GEN0(8(*CHK*))
                               END;
                             IF LMIN <> 0 THEN
                               BEGIN GENLDC(ABS(LMIN));
                                 IF LMIN > 0 THEN GEN0(21(*SBI*))
                                 ELSE GEN0(2(*ADI*))
                               END
                           END
                       END
                     ELSE ERROR(139);
                     WITH GATTR DO
                       BEGIN TYPTR := AELTYPE; KIND := VARBL;
                         ACCESS := INDRCT; IDPLMT := 0;
                         IF TYPTR <> NIL THEN
                           IF AISPACKD THEN
                             IF ELWIDTH = 8 THEN
                               BEGIN ACCESS := BYTE;
                                 IF STRGTYPE(LATTR.TYPTR) AND RANGECHECK THEN
                                   GEN0(27(*IXS*))
                                 ELSE GEN0(2(*ADI*))
                               END
                             ELSE
                               BEGIN ACCESS := PACKD;
                                 GEN2(64(*IXP*),ELSPERWD,ELWIDTH)
                               END
                           ELSE
                             BEGIN GEN1(36(*IXA*),TYPTR^.SIZE);
                               IF (TYPTR^.FORM <= POWER) AND
                                  (TYPTR^.SIZE > PTRSIZE) THEN
                                 ACCESS := MULTI
                             END
                       END
                   END
             UNTIL SY <> COMMA;
             IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
           END (*IF SY = LBRACK*)
         ELSE
   (*.*)   IF SY = PERIOD THEN
             BEGIN
               WITH GATTR DO
                 BEGIN
                   IF TYPTR <> NIL THEN
                     IF TYPTR^.FORM <> RECORDS THEN
                       BEGIN ERROR(140); TYPTR := NIL END;
                   INSYMBOL;
                   IF SY = IDENT THEN
                     BEGIN
                       IF TYPTR <> NIL THEN
                         BEGIN SEARCHSECTION(TYPTR^.FSTFLD,LCP);
                           IF LCP = NIL THEN
                             BEGIN ERROR(152); TYPTR := NIL END
                           ELSE
                             WITH LCP^ DO
                               BEGIN TYPTR := IDTYPE;
                                 CASE ACCESS OF
                                   DRCT:   DPLMT := DPLMT + FLDADDR;
                                   INDRCT: IDPLMT := IDPLMT + FLDADDR;
                                   MULTI,BYTE,
                                   PACKD:  ERROR(400)
                                 END (*CASE ACCESS*);
                                 IF FISPACKD THEN
                                   BEGIN LOADADDRESS;
                                     IF ((FLDRBIT = 0) OR (FLDRBIT = 8))
                                         AND (FLDWIDTH = 8) THEN
                                       BEGIN ACCESS := BYTE;
                                         IF FLDRBIT = 8 THEN GEN1(34(*INC*),1)
                                       END
                                     ELSE
                                       BEGIN ACCESS := PACKD;
                                         GENLDC(FLDWIDTH); GENLDC(FLDRBIT)
                                       END
                                   END;
                                 IF TYPTR <> NIL THEN
                                   IF (TYPTR^.FORM <= POWER) AND
                                      (TYPTR^.SIZE > PTRSIZE) THEN
                                     BEGIN LOADADDRESS; ACCESS := MULTI END
                               END
                         END;
                       INSYMBOL
                     END (*SY = IDENT*)
                   ELSE ERROR(2)
                 END (*WITH GATTR*)
             END (*IF SY = PERIOD*)
           ELSE
   (*^*)     BEGIN
               IF GATTR.TYPTR <> NIL THEN
                 WITH GATTR,TYPTR^ DO
                   IF (FORM = POINTER) OR (FORM = FILES) THEN
                     BEGIN LOAD; KIND := VARBL;
                       ACCESS := INDRCT; IDPLMT := 0;
                       IF FORM = POINTER THEN TYPTR := ELTYPE
                       ELSE
                         BEGIN TYPTR := FILTYPE;
                           IF TYPTR = NIL THEN ERROR(399)
                         END;
                       IF TYPTR <> NIL THEN
                         IF (TYPTR^.FORM <= POWER) AND
                            (TYPTR^.SIZE > PTRSIZE) THEN
                                 ACCESS := MULTI
                     END
                   ELSE ERROR(141);
               INSYMBOL
             END;
         IF NOT (SY IN FSYS + SELECTSYS) THEN
           BEGIN ERROR(6); SKIP(FSYS + SELECTSYS) END
       END (*WHILE*)

   END (*SELECTOR*) ;
			
 (* $I BODYPART.B.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

   PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP);
     VAR LKEY: 1..43; WASLPARENT: BOOLEAN;

     PROCEDURE VARIABLE(FSYS: SETOFSYS);
       VAR LCP: CTP;
     BEGIN
       IF SY = IDENT THEN
         BEGIN SEARCHID(VARS+[FIELD],LCP); INSYMBOL END
       ELSE BEGIN ERROR(2); LCP := UVARPTR END;
       SELECTOR(FSYS,LCP)
     END (*VARIABLE*) ;

     PROCEDURE STRGVAR(FSYS: SETOFSYS; MUSTBEVAR: BOOLEAN);
     BEGIN EXPRESSION(FSYS);
       WITH GATTR DO
         IF ((KIND = CST) AND (TYPTR = CHARPTR))
             OR STRGTYPE(TYPTR) THEN
           IF KIND = VARBL THEN LOADADDRESS
           ELSE
             BEGIN
               IF MUSTBEVAR THEN ERROR(154);
               IF KIND = CST THEN
                 BEGIN
                   IF TYPTR = CHARPTR THEN
                     BEGIN
                       WITH SCONST^ DO
                         BEGIN CCLASS := STRG; SLGTH := 1;
                           SVAL[1] := CHR(CVAL.IVAL)
                         END;
                       CVAL.VALP := SCONST;
                       NEW(TYPTR,ARRAYS,TRUE,TRUE);
                       TYPTR^ := STRGPTR^;
                       TYPTR^.MAXLENG := 1
                     END;
                   LOADADDRESS
                 END
             END
         ELSE
           BEGIN
             IF GATTR.TYPTR <> NIL THEN ERROR(125);
             GATTR.TYPTR := STRGPTR
           END
     END (*STRGVAR*) ;

     PROCEDURE ROUTINE(LKEY: INTEGER);

       PROCEDURE NEWSTMT;
         LABEL 1;
         VAR LSP,LSP1: STP; VARTS,LMIN,LMAX: INTEGER;
             LSIZE,LSZ: ADDRRANGE; LVAL: VALU;

       BEGIN VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
         LSP := NIL; VARTS := 0; LSIZE := 0;
         IF GATTR.TYPTR <> NIL THEN
           WITH GATTR.TYPTR^ DO
             IF FORM = POINTER THEN
               BEGIN
                 IF ELTYPE <> NIL THEN
                   WITH ELTYPE^ DO
                     BEGIN LSIZE := SIZE;
                       IF FORM = RECORDS THEN LSP := RECVAR
                     END
               END
             ELSE ERROR(116);
         WHILE SY = COMMA DO
           BEGIN INSYMBOL;
             CONSTANT(FSYS + [COMMA,RPARENT],LSP1,LVAL);
             VARTS := VARTS + 1;
             IF LSP = NIL THEN ERROR(158)
             ELSE
               IF LSP^.FORM <> TAGFLD THEN ERROR(162)
               ELSE
                 IF LSP^.TAGFIELDP <> NIL THEN
                   IF STRGTYPE(LSP1) OR (LSP1 = REALPTR) THEN ERROR(159)
                   ELSE
                     IF COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP1) THEN
                       BEGIN
                         LSP1 := LSP^.FSTVAR;
                         WHILE LSP1 <> NIL DO
                           WITH LSP1^ DO
                             IF VARVAL.IVAL = LVAL.IVAL THEN
                               BEGIN LSIZE := SIZE; LSP := SUBVAR;
                                 GOTO 1
                               END
                             ELSE LSP1 := NXTVAR;
                         LSIZE := LSP^.SIZE; LSP := NIL;
                       END
                     ELSE ERROR(116);
       1:  END (*WHILE*) ;
         GENLDC(LSIZE);
         GEN1(30(*CSP*),1(*NEW*))
       END (*NEWSTMT*) ;

       PROCEDURE MOVE;
       BEGIN VARIABLE(FSYS + [COMMA]); LOADADDRESS;
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         IF LKEY = 27 THEN
           BEGIN EXPRESSION(FSYS + [COMMA]); LOAD END
         ELSE
           BEGIN VARIABLE(FSYS + [COMMA]); LOADADDRESS END;
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         EXPRESSION(FSYS + [RPARENT]); LOAD;
         IF LKEY = 27 THEN GEN1(30(*CSP*),10(*FLC*))
         ELSE
           IF LKEY = 21 THEN GEN1(30(*CSP*),2(*MVL*))
           ELSE GEN1(30(*CSP*),3(*MVR*))
       END (*MOVE*) ;

       PROCEDURE EXIT;
         VAR LCP: CTP;
       BEGIN
         IF SY = IDENT THEN
           BEGIN SEARCHID([PROC,FUNC],LCP); INSYMBOL END
         ELSE
           IF (SY = PROGSY) THEN
             BEGIN LCP := OUTERBLOCK; INSYMBOL END
           ELSE LCP := NIL;
         IF LCP <> NIL THEN
           IF LCP^.PFDECKIND = DECLARED THEN
             BEGIN GENLDC(LCP^.PFSEG); GENLDC(LCP^.PFNAME);
               IF INMODULE THEN
                 BEGIN LINKERREF(PROC,LCP^.PFSEG,IC-2);
                   IF SEPPROC THEN LINKERREF(PROC,-LCP^.PFNAME,IC-1);
                 END
             END
           ELSE ERROR(125)
         ELSE ERROR(125);
         GEN1(30(*CSP*),4(*XIT*))
       END (*EXIT*) ;

       PROCEDURE UNITIO;
       BEGIN
         IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         VARIABLE(FSYS + [COMMA]); LOADADDRESS;
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD;
         IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
         IF SY = COMMA THEN
           BEGIN INSYMBOL;
             IF SY = COMMA THEN GENLDC(0)
             ELSE
               BEGIN
                 EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD;
                 IF GATTR.TYPTR <> INTPTR THEN ERROR(125)
               END
           END
         ELSE GENLDC(0);
         IF SY = COMMA THEN
           BEGIN INSYMBOL;
             EXPRESSION(FSYS + [RPARENT]); LOAD;
             IF GATTR.TYPTR <> INTPTR THEN ERROR(125)
           END
         ELSE GENLDC(0);
         IF LKEY = 13 THEN GEN1(30(*CSP*),5(*URD*))
         ELSE GEN1(30(*CSP*),6(*UWT*))
       END (*UNITIO*);

       PROCEDURE CONCAT;
         VAR LLC: ADDRRANGE; TEMPLGTH: INTEGER;
       BEGIN TEMPLGTH := 0;
         LLC := LC; LC := LC + (STRGLGTH DIV CHRSPERWD) + 1;
         GENLDC(0); GEN2(56(*STR*),0,LLC);
         GEN2(50(*LDA*),0,LLC);
         REPEAT
           STRGVAR(FSYS + [COMMA,RPARENT],FALSE);
           TEMPLGTH := TEMPLGTH + GATTR.TYPTR^.MAXLENG;
           IF TEMPLGTH < STRGLGTH THEN GENLDC(TEMPLGTH)
           ELSE GENLDC(STRGLGTH);
           GEN2(77(*CXP*),0(*SYS*),23(*SCONCAT*));
           GEN2(50(*LDA*),0,LLC);
           TEST := SY <> COMMA;
           IF NOT TEST THEN INSYMBOL
         UNTIL TEST;
         IF TEMPLGTH < STRGLGTH THEN
           LC := LLC + (TEMPLGTH DIV CHRSPERWD) + 1
         ELSE TEMPLGTH := STRGLGTH;
         IF LC > LCMAX THEN LCMAX := LC;
         LC := LLC;
         WITH GATTR DO
           BEGIN NEW(TYPTR,ARRAYS,TRUE,TRUE);
             TYPTR^ := STRGPTR^;
             TYPTR^.MAXLENG := TEMPLGTH
           END
       END (*CONCAT*) ;

       PROCEDURE COPYDELETE;
         VAR LLC: ADDRRANGE; LSP: STP;
       BEGIN
         IF LKEY = 19 THEN
           BEGIN LLC := LC;
             LC := LC + (STRGLGTH DIV CHRSPERWD) + 1;
           END;
         IF LKEY <> 43 THEN
           BEGIN
             STRGVAR(FSYS + [COMMA], LKEY = 18);
             IF LKEY = 19 THEN
               BEGIN LSP := GATTR.TYPTR;
                 GEN2(50(*LDA*),0,LLC)
               END;
             IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
           END;
         EXPRESSION(FSYS + [COMMA]); LOAD;
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         EXPRESSION(FSYS + [RPARENT]); LOAD;
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
         IF LKEY = 19 THEN
           BEGIN
             GEN2(77(*CXP*),0(*SYS*),25(*SCOPY*));
             GEN2(50(*LDA*),0,LLC);
             IF LSP^.MAXLENG < STRGLGTH THEN
               LC := LLC + (LSP^.MAXLENG DIV CHRSPERWD) + 1;
             IF LC > LCMAX THEN LCMAX := LC;
             LC := LLC; GATTR.TYPTR := LSP
           END
         ELSE
           IF LKEY = 43 THEN
             GEN2(77(*CXP*),0(*SYS*),29(*GOTOXY*))
           ELSE GEN2(77(*CXP*),0(*SYS*),26(*SDELETE*))
       END (*COPYDELETE*) ;

       PROCEDURE STR;
       BEGIN
         WITH GATTR DO
           BEGIN
             IF COMPTYPES(LONGINTPTR,TYPTR) THEN
             ELSE IF TYPTR = INTPTR THEN
                    BEGIN GENLDC(1); TYPTR := LONGINTPTR END
                  ELSE ERROR(125);
             IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
             STRGVAR(FSYS + [RPARENT], TRUE);
             IF STRGTYPE(TYPTR) THEN
               BEGIN GENLDC(TYPTR^.MAXLENG); GENLDC(12(*DSTR*));
                 GENNR(DECOPS)
               END
             ELSE ERROR(116);
           END
       END (*STR*);

       PROCEDURE CLOSE;
       BEGIN
         VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125);
         IF SY = COMMA THEN
           BEGIN INSYMBOL;
             IF SY = IDENT THEN
              BEGIN
               IF ID = 'NORMAL  ' THEN GENLDC(0)
               ELSE
                 IF ID = 'LOCK    ' THEN GENLDC(1)
                 ELSE
                   IF ID = 'PURGE   ' THEN GENLDC(2)
                   ELSE
                     IF ID = 'CRUNCH  ' THEN GENLDC(3)
                     ELSE ERROR(2);
               INSYMBOL
              END
             ELSE ERROR(2)
           END
         ELSE GENLDC(0);
         GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*));
         IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*))
       END (*CLOSE*) ;

       PROCEDURE GETPUTETC;
       BEGIN
         VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125)
           ELSE
             IF GATTR.TYPTR^.FILTYPE = NIL THEN ERROR(399);
         CASE LKEY OF
           32:  BEGIN
                   IF SY = COMMA THEN
                     BEGIN
                       INSYMBOL; EXPRESSION(FSYS + [RPARENT]); LOAD;
                       IF GATTR.TYPTR <> INTPTR THEN ERROR(125)
                     END
                   ELSE ERROR(125);
                   GENNR(SEEK)
                END;
           34:  GEN2(77(*CXP*),0(*SYS*),7(*FGET*));
           35:  GEN2(77(*CXP*),0(*SYS*),8(*FPUT*));
           40:  BEGIN
                   IF GATTR.TYPTR <> NIL THEN
                     IF GATTR.TYPTR^.FILTYPE <> CHARPTR THEN ERROR(399);
                   GENLDC(12); GENLDC(0);
                   GEN2(77(*CXP*),0(*SYS*),17(*WRC*))
                END
         END (*CASE*) ;
         IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*))
       END (*GETPUTETC*) ;

       PROCEDURE SCAN;
       BEGIN
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         IF SY = RELOP THEN
           BEGIN
             IF OP = EQOP THEN GENLDC(0)
             ELSE
               IF OP = NEOP THEN GENLDC(1)
               ELSE ERROR(125);
             INSYMBOL
           END
         ELSE ERROR(125);
         EXPRESSION(FSYS + [COMMA]); LOAD;
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR <> CHARPTR THEN ERROR(125);
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
         IF SY = COMMA THEN
           BEGIN INSYMBOL;
             EXPRESSION(FSYS + [RPARENT]); LOAD
           END
         ELSE GENLDC(0);
         GEN1(30(*CSP*),11(*SCN*));
         GATTR.TYPTR := INTPTR
       END (*SCAN*) ;

       PROCEDURE BLOCKIO;
       BEGIN
         VARIABLE(FSYS + [COMMA]); LOADADDRESS;
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125)
           ELSE
             IF GATTR.TYPTR^.FILTYPE <> NIL THEN ERROR(399);
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         VARIABLE(FSYS + [COMMA]); LOADADDRESS;
         IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
         EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD;
         IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
         IF SY = COMMA THEN
           BEGIN INSYMBOL;
             EXPRESSION(FSYS + [RPARENT]); LOAD;
             IF GATTR.TYPTR <> INTPTR THEN ERROR(125)
           END
         ELSE GENLDC(-1);
         IF LKEY = 37 THEN GENLDC(1) ELSE GENLDC(0);
         GENLDC(0); GENLDC(0);
         GEN2(77(*CXP*),0(*SYS*),28(*BLOCKIO*));
         IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*));
         GATTR.TYPTR := INTPTR
       END (*BLOCKIO*) ;

       PROCEDURE SIZEOF;
         VAR LCP: CTP;
       BEGIN
         IF SY = IDENT THEN
           BEGIN SEARCHID(VARS + [TYPES,FIELD],LCP); INSYMBOL;
             IF LCP^.IDTYPE <> NIL THEN
               GENLDC(LCP^.IDTYPE^.SIZE*CHRSPERWD)
           END;
         GATTR.TYPTR := INTPTR
       END (*SIZEOF*) ;

   BEGIN (*ROUTINE*)
     CASE LKEY OF
       12:      NEWSTMT;
       13,14:   UNITIO;
       15:      CONCAT;
       18,19,43:COPYDELETE;
       21,22,27:MOVE;
       23:      EXIT;
       31:      CLOSE;
       32,34,
       35,40:   GETPUTETC;
       36:      SCAN;
       37,38:   BLOCKIO;
       41:      SIZEOF;
       42:      STR
     END (*CASES*)
   END (*ROUTINE*) ;

 (* $I BODYPART.C.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

     PROCEDURE LOADIDADDR(FCP: CTP);
     BEGIN
         WITH FCP^ DO
           IF KLASS = ACTUALVARS THEN
             IF VLEV = 1 THEN GEN1(37(*LAO*),VADDR)
             ELSE GEN2(50(*LDA*),LEVEL-VLEV,VADDR)
           ELSE  (*FORMALVARS*)
             IF VLEV = 1 THEN GEN1(39(*LDO*),VADDR)
             ELSE GEN2(54(*LOD*),LEVEL-VLEV,VADDR)
     END (*LOADIDADDR*) ;

     PROCEDURE READ;
       VAR FILEPTR,LCP: CTP;
     BEGIN FILEPTR := INPUTPTR;
       IF (SY = IDENT) AND WASLPARENT THEN
         BEGIN SEARCHID(VARS+[FIELD],LCP);
           IF LCP^.IDTYPE <> NIL THEN
             IF LCP^.IDTYPE^.FORM = FILES THEN
               IF LCP^.IDTYPE^.FILTYPE = CHARPTR THEN
                 BEGIN INSYMBOL; FILEPTR := LCP;
                   IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20);
                   IF SY = COMMA THEN INSYMBOL
                 END
         END
       ELSE
         IF WASLPARENT THEN ERROR(2);
       IF WASLPARENT AND (SY <> RPARENT) THEN
         BEGIN
           REPEAT LOADIDADDR(FILEPTR);
             VARIABLE(FSYS + [COMMA,RPARENT]);
             IF GATTR.ACCESS = BYTE THEN ERROR(103);
             LOADADDRESS;
             IF GATTR.TYPTR <> NIL THEN
               IF COMPTYPES(INTPTR,GATTR.TYPTR) THEN
                 GEN2(77(*CXP*),0(*SYS*),12(*FRDI*))
               ELSE
                 IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN
                   GENNR(FREADREAL)
                 ELSE
                   IF COMPTYPES(LONGINTPTR,GATTR.TYPTR) THEN
                     BEGIN GENLDC(GATTR.TYPTR^.SIZE);
                       GENNR(FREADDEC)
                     END
                   ELSE
                     IF COMPTYPES(CHARPTR,GATTR.TYPTR) THEN
                       GEN2(77(*CXP*),0(*SYS*),16(*FRDC*))
                     ELSE
                       IF STRGTYPE(GATTR.TYPTR) THEN
                         BEGIN GENLDC(GATTR.TYPTR^.MAXLENG);
                           GEN2(77(*CXP*),0(*SYS*),18(*FRDS*))
                         END
                       ELSE ERROR(125);
             IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*));
             TEST := SY <> COMMA;
             IF NOT TEST THEN INSYMBOL
           UNTIL TEST
         END;
       IF LKEY = 2 THEN
         BEGIN LOADIDADDR(FILEPTR);
           GEN2(77(*CXP*),0(*SYS*),21(*FRLN*));
           IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*))
         END
     END (*READ*) ;

     PROCEDURE WRITE;
       VAR LSP: STP; DEFAULT: BOOLEAN;
           FILEPTR,LCP: CTP; LEN,LMIN,LMAX: INTEGER;
     BEGIN FILEPTR := OUTPUTPTR;
       IF (SY = IDENT) AND WASLPARENT THEN
         BEGIN SEARCHID(VARS + [FIELD,KONST,FUNC],LCP);
           IF LCP^.IDTYPE <> NIL THEN
             IF LCP^.IDTYPE^.FORM = FILES THEN
               IF LCP^.IDTYPE^.FILTYPE = CHARPTR THEN
                 BEGIN INSYMBOL; FILEPTR := LCP;
                   IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20);
                   IF SY = COMMA THEN INSYMBOL
                 END
         END;
       IF WASLPARENT AND (SY <> RPARENT) THEN
         BEGIN
           REPEAT LOADIDADDR(FILEPTR);
             EXPRESSION(FSYS + [COMMA,COLON,RPARENT]);
             LSP := GATTR.TYPTR;
             IF LSP <> NIL THEN
               WITH LSP^ DO
                 BEGIN
                   IF FORM > LONGINT THEN LOADADDRESS
                   ELSE
                     BEGIN LOAD;
                       IF FORM = LONGINT THEN
                         BEGIN GENLDC(DECSIZE(MAXDEC)); GENLDC(0(*DAJ*));
                           GENNR(DECOPS)
                         END
                     END
                 END;
             IF SY = COLON THEN
               BEGIN INSYMBOL;
                 EXPRESSION(FSYS + [COMMA,COLON,RPARENT]);
                 IF GATTR.TYPTR <> NIL THEN
                   IF GATTR.TYPTR <> INTPTR THEN ERROR(20);
                 LOAD; DEFAULT := FALSE
               END
             ELSE DEFAULT := TRUE;
             IF LSP = INTPTR THEN
               BEGIN IF DEFAULT THEN GENLDC(0);
                 GEN2(77(*CXP*),0(*SYS*),13(*FWRI*))
               END
             ELSE
               IF LSP = REALPTR THEN
                 BEGIN IF DEFAULT THEN GENLDC(0);
                   IF SY = COLON THEN
                     BEGIN INSYMBOL;
                       EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD;
                       IF GATTR.TYPTR <> NIL THEN
                         IF GATTR.TYPTR <> INTPTR THEN ERROR(125)
                     END
                   ELSE GENLDC(0);
                   GENNR(FWRITEREAL)
                 END
               ELSE
                 IF COMPTYPES(LSP,LONGINTPTR) THEN
                   BEGIN IF DEFAULT THEN GENLDC(0); GENNR(FWRITEDEC) END
                 ELSE
                   IF LSP = CHARPTR THEN
                     BEGIN IF DEFAULT THEN GENLDC(0);
                       GEN2(77(*CXP*),0(*SYS*),17(*FWRC*))
                     END
                   ELSE
                     IF STRGTYPE(LSP) THEN
                       BEGIN IF DEFAULT THEN GENLDC(0);
                         GEN2(77(*CXP*),0(*SYS*),19(*FWRS*))
                       END
                     ELSE
                       IF PAOFCHAR(LSP) THEN
                         BEGIN LMAX := 0;
                           IF LSP^.INXTYPE <> NIL THEN
                             BEGIN GETBOUNDS(LSP^.INXTYPE,LMIN,LMAX);
                                LMAX := LMAX - LMIN + 1
                             END;
                           IF DEFAULT THEN GENLDC(LMAX);
                           GENLDC(LMAX);
                           GEN2(77(*CXP*),0(*SYS*),20(*FWRB*))
                         END
                       ELSE ERROR(125);
             IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*));
             TEST := SY <> COMMA;
             IF NOT TEST THEN INSYMBOL
           UNTIL TEST;
         END;
       IF LKEY = 4 THEN (*WRITELN*)
         BEGIN LOADIDADDR(FILEPTR);
           GEN2(77(*CXP*),0(*SYS*),22(*FWLN*));
           IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*))
         END
     END (*WRITE*) ;

     PROCEDURE CALLNONSPECIAL;
       LABEL 1;
       VAR NXT,LCP: CTP; LSP: STP; LB: BOOLEAN;
           LMIN,LMAX: INTEGER;
     BEGIN
       WITH FCP^ DO
         BEGIN NXT := NEXT;
           IF PFDECKIND = DECLARED THEN
             IF PFKIND <> ACTUAL THEN ERROR(400)
         END;
       IF SY = LPARENT THEN
         BEGIN
           REPEAT
             IF NXT = NIL THEN ERROR(126);
             INSYMBOL;
             EXPRESSION(FSYS + [COMMA,RPARENT]);
             IF (GATTR.TYPTR <> NIL) AND (NXT <> NIL) THEN
               BEGIN LSP := NXT^.IDTYPE;
                 IF (NXT^.KLASS = FORMALVARS) OR (LSP <> NIL) THEN
                   BEGIN
                     IF NXT^.KLASS = ACTUALVARS THEN
                       IF GATTR.TYPTR^.FORM <= POWER THEN
                         BEGIN LB := (GATTR.TYPTR = CHARPTR)
                                     AND (GATTR.KIND = CST);
                           LOAD;
                           IF LSP^.FORM = POWER THEN
                             GEN1(32(*ADJ*),LSP^.SIZE)
                           ELSE
                           IF LSP^.FORM = LONGINT THEN
                             BEGIN
                               IF GATTR.TYPTR = INTPTR THEN
                                 BEGIN GENLDC(INTSIZE);
                                   GATTR.TYPTR := LONGINTPTR
                                 END;
                               GENLDC(LSP^.SIZE);
                               GENLDC(0(*DAJ*));
                               GENNR(DECOPS)
                             END
                           ELSE
                           IF (LSP^.FORM = SUBRANGE)
                                 AND RANGECHECK THEN
                             BEGIN GENLDC(LSP^.MIN.IVAL);
                               GENLDC(LSP^.MAX.IVAL);
                               GEN0(8(*CHK*))
                             END
                           ELSE
                           IF (GATTR.TYPTR = INTPTR) AND
                                 COMPTYPES(LSP,REALPTR) THEN
                             BEGIN GEN0(10(*FLT*));
                               GATTR.TYPTR := REALPTR
                             END
                           ELSE
                           IF LB AND STRGTYPE(LSP) THEN
                             GATTR.TYPTR := STRGPTR
                         END
                       ELSE (*FORM > POWER*)
                         BEGIN LB := STRGTYPE(GATTR.TYPTR)
                                     AND (GATTR.KIND = CST);
                           LOADADDRESS;
                           IF LB AND PAOFCHAR(LSP) THEN
                             IF NOT LSP^.AISSTRNG THEN
                               BEGIN GEN0(80(*S1P*));
                                 IF LSP^.INXTYPE <> NIL THEN
                                   BEGIN
                                     GETBOUNDS(LSP^.INXTYPE,LMIN,LMAX);
                                     IF LMAX-LMIN+1 <>
                                         GATTR.TYPTR^.MAXLENG THEN ERROR(142);
                                   END;
                                 GATTR.TYPTR := LSP
                               END
                         END
                     ELSE (*KLASS = FORMALVARS*)
                       IF GATTR.KIND = VARBL THEN
                         BEGIN
                           IF GATTR.ACCESS = BYTE THEN ERROR(103);
                           LOADADDRESS;
                           IF LSP <> NIL THEN
                             IF LSP^.FORM IN [POWER,LONGINT] THEN
                               IF GATTR.TYPTR^.SIZE <>
                                   LSP^.SIZE THEN ERROR(142)
                         END
                       ELSE ERROR(154);
                     IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(142)
                   END
               END;
             IF NXT <> NIL THEN NXT := NXT^.NEXT
           UNTIL SY <> COMMA;
           IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
         END (*LPARENT*) ;
       IF NXT <> NIL THEN ERROR(126);
       WITH FCP^ DO
         IF PFDECKIND = DECLARED THEN
           BEGIN
             IF KLASS = FUNC THEN
               BEGIN GENLDC(0); GENLDC(0) END;
             IF INMODULE THEN
               IF SEPPROC THEN
                 IF (PFSEG = SEG) AND (PFLEV = 1) THEN
                   BEGIN GEN1(79(*CGP*),0); LINKERREF(PROC,-PFNAME,IC-1) END
                 ELSE
                   IF PFLEV = 0 THEN GEN2(77(*CXP*),PFSEG,PFNAME)
                   ELSE ERROR(405) (*CALL NOT ALLOWED IN SEP PROC*)
               ELSE
                 IF IMPORTED THEN
                   BEGIN GEN2(77(*CXP*),0,PFNAME); LINKERREF(PROC,PFSEG,IC-2) END
                 ELSE GOTO 1
             ELSE
        1:     IF PFSEG <> SEG THEN
                 GEN2(77(*CXP*),PFSEG,PFNAME)
               ELSE
                 IF PFLEV = 0 THEN GEN1(66(*CBP*),PFNAME)
                 ELSE
                   IF PFLEV = LEVEL THEN GEN1(78(*CLP*),PFNAME)
                   ELSE
                     IF PFLEV = 1 THEN GEN1(79(*CGP*),PFNAME)
                     ELSE GEN1(46(*CIP*),PFNAME)
           END
         ELSE
           IF CSPNUM = 23 THEN GEN1(30,40)  (* TEMP I.5 TRANSLATION --
                                               MEM WILL BE CSP 23 IN II.0  *)
           ELSE
             IF (CSPNUM <> 21) AND (CSPNUM <> 22) THEN
               GEN1(30(*CSP*),CSPNUM);
       GATTR.TYPTR := FCP^.IDTYPE
     END (*CALLNONSPECIAL*) ;

   BEGIN (*CALL*)
     IF FCP^.PFDECKIND = SPECIAL THEN
       BEGIN WASLPARENT := TRUE; LKEY := FCP^.KEY;
         IF SY = LPARENT THEN INSYMBOL
         ELSE
           IF LKEY IN [2,4,5,6] THEN WASLPARENT := FALSE
           ELSE ERROR(9);
         IF LKEY IN [7,8,9,10,11,13,14,25,36,39,42] THEN
           BEGIN EXPRESSION(FSYS + [COMMA,RPARENT]); LOAD END;
         IF LKEY IN [12,13,14,15,18,19,21,22,23,27,31,32,34,35,36,37,38,
                     40,41,42,43] THEN ROUTINE(LKEY)
         ELSE
           CASE LKEY OF
              1,2: READ;
              3,4: WRITE;
              5,6: BEGIN (*EOF & EOLN*)
                     IF WASLPARENT THEN
                       BEGIN VARIABLE(FSYS + [RPARENT]); LOADADDRESS;
                         IF GATTR.TYPTR <> NIL THEN
                           IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125)
                           ELSE
                             IF (GATTR.TYPTR^.FILTYPE <> CHARPTR) AND
                                 (LKEY = 6) THEN ERROR(399)
                       END
                     ELSE
                       LOADIDADDR(INPUTPTR);
                     GENLDC(0); GENLDC(0);
                     IF LKEY = 5 THEN GEN2(77(*CXP*),0(*SYS*),10(*FEOF*))
                     ELSE GEN2(77(*CXP*),0(*SYS*),11(*FEOLN*));
                     GATTR.TYPTR := BOOLPTR
                   END (*EOF*) ;
              7,8: BEGIN GENLDC(1); (*PREDSUCC*)
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR^.FORM = SCALAR THEN
                         IF LKEY = 8 THEN GEN0(2(*ADI*))
                         ELSE GEN0(21(*SBI*))
                       ELSE ERROR(115)
                   END (*PREDSUCC*) ;
                9: BEGIN (*ORD*)
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR^.FORM >= POWER THEN ERROR(125);
                     GATTR.TYPTR := INTPTR
                   END (*ORD*) ;
               10: BEGIN (*SQR*)
                     IF GATTR.TYPTR <> NIL THEN
                     IF GATTR.TYPTR = INTPTR THEN GEN0(24(*SQI*))
                     ELSE
                       IF GATTR.TYPTR = REALPTR THEN GEN0(25(*SQR*))
                       ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END
                   END (*SQR*) ;
               11: BEGIN (*ABS*)
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR = INTPTR THEN GEN0(0(*ABI*))
                       ELSE
                         IF GATTR.TYPTR = REALPTR THEN GEN0(1(*ABR*))
                         ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END
                   END (*ABS*) ;
               16: BEGIN (*LENGTH*)
                     STRGVAR(FSYS + [RPARENT],FALSE);
                     GEN0(62(*LDB*)); GATTR.TYPTR := INTPTR
                   END (*LENGTH*) ;
               17: BEGIN (*INSERT*)
                     STRGVAR(FSYS + [COMMA],FALSE);
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     STRGVAR(FSYS + [COMMA],TRUE);
                     GENLDC(GATTR.TYPTR^.MAXLENG);
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     EXPRESSION(FSYS + [RPARENT]); LOAD;
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
                     GEN2(77(*CXP*),0(*SYS*),24(*SINSERT*))
                   END (*INSERT*) ;
               20: BEGIN (*POS*)
                     STRGVAR(FSYS + [COMMA],FALSE);
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     STRGVAR(FSYS + [RPARENT],FALSE);
                     GENLDC(0); GENLDC(0);
                     GEN2(77(*CXP*),0(*SYS*),27(*SPOS*));
                     GATTR.TYPTR := INTPTR
                   END (*POS*) ;
               24: BEGIN (*IDSEARCH*)
                     VARIABLE(FSYS + [COMMA]); LOADADDRESS;
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     VARIABLE(FSYS + [RPARENT]); LOADADDRESS;
                     GEN1(30(*CSP*),7(*IDS*))
                   END (*IDSEARCH*) ;
               25: BEGIN (*TREESEARCH*)
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     VARIABLE(FSYS + [COMMA]); LOADADDRESS;
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     VARIABLE(FSYS + [RPARENT]); LOADADDRESS;
                     GATTR.TYPTR := INTPTR;
                     GEN1(30(*CSP*),8(*TRS*))
                   END (*TREESEARCH*) ;
               26: BEGIN (*TIME*)
                     VARIABLE(FSYS + [COMMA]); LOADADDRESS;
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
                     IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
                     VARIABLE(FSYS + [RPARENT]); LOADADDRESS;
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
                     GEN1(30(*CSP*),9(*TIM*))
                   END (*TIME*) ;
      33,28,29,30: BEGIN (*OPEN,RESET,REWRITE*)
                     VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125);
                     IF SY <> COMMA THEN
                       IF LKEY = 33 THEN
                         GEN2(77(*CXP*),0(*SYS*),4(*FRESET*))
                       ELSE ERROR(20)
                     ELSE
                       BEGIN INSYMBOL;
                         STRGVAR(FSYS + [RPARENT],FALSE);
                         IF (LKEY = 28) OR (LKEY = 30) THEN
                           GENLDC(0)
                         ELSE GENLDC(1);
                         GENLDC(0); GEN2(77(*CXP*),0(*SYS*),5(*FOPEN*))
                       END;
                     IF IOCHECK THEN GEN1(30(*CSP*),0(*IOC*))
                   END (*OPEN*) ;
               39: BEGIN (*TRUNC*)
                     IF GATTR.TYPTR = INTPTR THEN
                       BEGIN GEN0(10(*FLT*));
                         GATTR.TYPTR := REALPTR
                       END;
                     IF GATTR.TYPTR <> NIL THEN
                       IF GATTR.TYPTR = REALPTR THEN
                         GEN1(30(*CSP*),23(*TRUNC*)) (*** TEMPORARY --
                                           TRUNC WILL BE CSP 14 IN II.0 ***)
                       ELSE
                         IF GATTR.TYPTR^.FORM = LONGINT THEN
                           BEGIN
                             GENLDC(INTSIZE); GENLDC(0 (*DAJ*));
                             GENNR(DECOPS)
                           END
                         ELSE ERROR(125);
                     GATTR.TYPTR := INTPTR
                   END
           END (*SPECIAL CASES*) ;
         IF WASLPARENT THEN
           IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
       END (*SPECIAL PROCEDURES AND FUNCTIONS*)
     ELSE CALLNONSPECIAL
   END (*CALL*) ;
			
 (* $I BODYPART.D.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

   PROCEDURE EXPRESSION(*FSYS: SETOFSYS*);
     LABEL 1;    (* STRING COMPARE KLUDGE *)
     VAR LATTR: ATTR; LOP: OPERATOR; TYPIND: INTEGER;
         LSIZE: ADDRRANGE; LSTRING,GSTRING: BOOLEAN;
         LMIN,LMAX: INTEGER;

     PROCEDURE FLOATIT(VAR FSP: STP; FORCEFLOAT: BOOLEAN);
     BEGIN
       IF (GATTR.TYPTR = REALPTR) OR (FSP = REALPTR) OR FORCEFLOAT THEN
         BEGIN
           IF GATTR.TYPTR = INTPTR THEN
             BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END;
           IF FSP = INTPTR THEN
             BEGIN GEN0(9(*FLO*)); FSP := REALPTR END
         END
     END (*FLOATIT*) ;

     PROCEDURE STRETCHIT(VAR FSP: STP);

     BEGIN
       IF (FSP^.FORM = LONGINT) OR (GATTR.TYPTR^.FORM = LONGINT) THEN
         IF GATTR.TYPTR = INTPTR THEN
           BEGIN GENLDC(INTSIZE); GATTR.TYPTR := LONGINTPTR END
         ELSE
           IF FSP = INTPTR THEN
             BEGIN GENLDC(14(*DCV*)); GENNR(DECOPS); FSP := LONGINTPTR END
     END (*STRETCHIT*) ;

     PROCEDURE SIMPLEEXPRESSION(FSYS: SETOFSYS);
       VAR LATTR: ATTR; LOP: OPERATOR; SIGNED: BOOLEAN;

       PROCEDURE TERM(FSYS: SETOFSYS);
         VAR LATTR: ATTR; LSP: STP; LOP: OPERATOR;

         PROCEDURE FACTOR(FSYS: SETOFSYS);
           VAR LCP: CTP; LVP: CSP; VARPART,ALLCONST: BOOLEAN;
               LSP: STP; HIGHVAL,LOWVAL,LIC,LOP: INTEGER;
               CSTPART: SET OF 0..127;
         BEGIN
           IF NOT (SY IN FACBEGSYS) THEN
             BEGIN ERROR(58); SKIP(FSYS + FACBEGSYS);
               GATTR.TYPTR := NIL
             END;
           WHILE SY IN FACBEGSYS DO
             BEGIN
               CASE SY OF
         (*ID*)  IDENT:
                   BEGIN SEARCHID([KONST,FORMALVARS,ACTUALVARS,FIELD,FUNC],LCP);
                     INSYMBOL;
                     IF LCP^.KLASS = FUNC THEN
                       BEGIN CALL(FSYS,LCP); GATTR.KIND := EXPR END
                     ELSE
                       IF LCP^.KLASS = KONST THEN
                         WITH GATTR, LCP^ DO
                           BEGIN TYPTR := IDTYPE; KIND := CST;
                             CVAL := VALUES
                           END
                       ELSE SELECTOR(FSYS,LCP);
                     IF GATTR.TYPTR <> NIL THEN
                       WITH GATTR,TYPTR^ DO
                         IF FORM = SUBRANGE THEN TYPTR := RANGETYPE
                   END;
         (*CST*) INTCONST:
                   BEGIN
                     WITH GATTR DO
                       BEGIN TYPTR := INTPTR; KIND := CST;
                         CVAL := VAL
                       END;
                     INSYMBOL
                   END;
                 REALCONST:
                   BEGIN
                     WITH GATTR DO
                       BEGIN TYPTR := REALPTR; KIND := CST;
                         CVAL := VAL
                       END;
                     INSYMBOL
                   END;
                 STRINGCONST:
                   BEGIN
                     WITH GATTR DO
                       BEGIN
                         IF LGTH = 1 THEN TYPTR := CHARPTR
                         ELSE
                           BEGIN NEW(LSP,ARRAYS,TRUE,TRUE);
                             LSP^ := STRGPTR^;
                             LSP^.MAXLENG := LGTH;
                             TYPTR := LSP
                           END;
                         KIND := CST; CVAL := VAL
                       END;
                     INSYMBOL
                   END;
                 LONGCONST:
                   BEGIN
                     WITH GATTR DO
                       BEGIN NEW(LSP,LONGINT);
                         LSP^ := LONGINTPTR^;
                         LSP^.SIZE := DECSIZE(LGTH);
                         TYPTR := LSP; KIND := CST; CVAL := VAL
                       END;
                     INSYMBOL
                   END;
         (*(*)   LPARENT:
                   BEGIN INSYMBOL; EXPRESSION(FSYS + [RPARENT]);
                     IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
                   END;
         (*NOT*) NOTSY:
                   WITH GATTR DO
                     BEGIN INSYMBOL; FACTOR(FSYS);
                       IF (KIND = CST) AND (TYPTR = BOOLPTR) THEN
                         CVAL.IVAL := ORD(NOT ODD(CVAL.IVAL))
                       ELSE
                       BEGIN LOAD; GEN0(19(*NOT*));
                         IF TYPTR <> NIL THEN
                           IF TYPTR <> BOOLPTR THEN
                             BEGIN ERROR(135); TYPTR := NIL END
                       END
                     END;
         (*[*)   LBRACK:
                   BEGIN INSYMBOL; CSTPART := [ ]; VARPART := FALSE;
                     NEW(LSP,POWER);
                     WITH LSP^ DO
                       BEGIN ELSET := NIL; SIZE := 0; FORM := POWER END;
                     IF SY = RBRACK THEN
                       BEGIN
                         WITH GATTR DO
                           BEGIN TYPTR := LSP; KIND := CST END;
                         INSYMBOL
                       END
                     ELSE
                       BEGIN
                         REPEAT EXPRESSION(FSYS + [COMMA,RBRACK,COLON]);
                           IF GATTR.TYPTR <> NIL THEN
                             IF GATTR.TYPTR^.FORM <> SCALAR THEN
                               BEGIN ERROR(136); GATTR.TYPTR := NIL END
                             ELSE
                               IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN
                                 BEGIN ALLCONST := FALSE; LOP := 23(*SGS*);
                                   IF (GATTR.KIND = CST) AND
                                      (GATTR.CVAL.IVAL <= 127) THEN
                                     BEGIN ALLCONST := TRUE;
                                       LOWVAL := GATTR.CVAL.IVAL;
                                       HIGHVAL := LOWVAL
                                     END;
                                   LIC := IC; LOAD;
                                   IF SY = COLON THEN
                                     BEGIN INSYMBOL; LOP := 20(*SRS*);
                                       EXPRESSION(FSYS + [COMMA,RBRACK]);
                                       IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN
                                       ELSE
                                         BEGIN ERROR(137); GATTR.TYPTR:=NIL END;
                                       IF ALLCONST THEN
                                         IF (GATTR.KIND = CST) AND
                                            (GATTR.CVAL.IVAL <= 127) THEN
                                             HIGHVAL := GATTR.CVAL.IVAL
                                         ELSE
                                           BEGIN LOAD; ALLCONST := FALSE END
                                       ELSE LOAD
                                     END;
                                   IF ALLCONST THEN
                                     BEGIN IC := LIC; (*FORGET FIRST CONST*)
                                       CSTPART := CSTPART + [LOWVAL..HIGHVAL]
                                     END
                                   ELSE
                                     BEGIN GEN0(LOP);
                                       IF VARPART THEN GEN0(28(*UNI*))
                                       ELSE VARPART := TRUE
                                     END;
                                   LSP^.ELSET := GATTR.TYPTR;
                                   GATTR.TYPTR := LSP
                                 END
                               ELSE ERROR(137);
                           TEST := SY <> COMMA;
                           IF NOT TEST THEN INSYMBOL
                         UNTIL TEST;
                         IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
                       END;
                     IF VARPART THEN
                       BEGIN
                         IF CSTPART <> [ ] THEN
                           BEGIN
                             SCONST^.PVAL := CSTPART;
                             SCONST^.CCLASS := PSET;
                             GATTR.CVAL.VALP := SCONST;
                             GATTR.KIND := CST;
                             LOAD; GEN0(28(*UNI*))
                           END;
                         GATTR.KIND := EXPR
                       END
                     ELSE
                       BEGIN
                         SCONST^.PVAL := CSTPART;
                         SCONST^.CCLASS := PSET;
                         GATTR.CVAL.VALP := SCONST;
                         GATTR.KIND := CST
                       END
                   END
               END (*CASE*) ;
               IF NOT (SY IN FSYS) THEN
                 BEGIN ERROR(6); SKIP(FSYS + FACBEGSYS) END
             END (*WHILE*)
         END (*FACTOR*) ;

       BEGIN (*TERM*)
         FACTOR(FSYS + [MULOP]);
         WHILE SY = MULOP DO
           BEGIN LOAD; LATTR := GATTR; LOP := OP;
             INSYMBOL; FACTOR(FSYS + [MULOP]); LOAD;
             IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
               CASE LOP OF
       (***)     MUL:  BEGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR);
                         IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR)
                           THEN GEN0(15(*MPI*))
                         ELSE
                           IF (LATTR.TYPTR = REALPTR) AND
                              (GATTR.TYPTR = REALPTR) THEN GEN0(16(*MPR*))
                           ELSE
                             IF (GATTR.TYPTR^.FORM = LONGINT) AND
                                (LATTR.TYPTR^.FORM = LONGINT) THEN
                               BEGIN GENLDC(8(*DMP*)); GENNR(DECOPS) END
                             ELSE
                               IF (LATTR.TYPTR^.FORM = POWER)
                                   AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                                 GEN0(12(*INT*))
                               ELSE BEGIN ERROR(134); GATTR.TYPTR:=NIL END
                       END;
       (*/*)     RDIV: BEGIN FLOATIT(LATTR.TYPTR,TRUE);
                         IF (LATTR.TYPTR = REALPTR) AND
                            (GATTR.TYPTR = REALPTR) THEN GEN0(7(*DVR*))
                         ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                       END;
       (*DIV*)   IDIV: BEGIN STRETCHIT(LATTR.TYPTR);
                         IF (LATTR.TYPTR = INTPTR) AND
                            (GATTR.TYPTR = INTPTR) THEN GEN0(6(*DVI*))
                         ELSE
                           IF (LATTR.TYPTR^.FORM = LONGINT) AND
                              (GATTR.TYPTR^.FORM = LONGINT) THEN
                             BEGIN GENLDC(10(*DDV*)); GENNR(DECOPS) END
                           ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                       END;
       (*MOD*)   IMOD: IF (LATTR.TYPTR = INTPTR) AND
                          (GATTR.TYPTR = INTPTR) THEN GEN0(14(*MOD*))
                       ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END;
       (*AND*)   ANDOP:IF (LATTR.TYPTR = BOOLPTR) AND
                          (GATTR.TYPTR = BOOLPTR) THEN GEN0(4(*AND*))
                       ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
               END (*CASE*)
             ELSE GATTR.TYPTR := NIL
           END (*WHILE*)
       END (*TERM*) ;

     BEGIN (*SIMPLEEXPRESSION*)
       SIGNED := FALSE;
       IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN
         BEGIN SIGNED := OP = MINUS; INSYMBOL END;
       TERM(FSYS + [ADDOP]);
       IF SIGNED THEN
         BEGIN LOAD;
           IF GATTR.TYPTR = INTPTR THEN GEN0(17(*NGI*))
           ELSE
             IF GATTR.TYPTR = REALPTR THEN GEN0(18(*NGR*))
             ELSE
               IF GATTR.TYPTR^.FORM = LONGINT THEN
                 BEGIN GENLDC(6(*DNG*)); GENNR(DECOPS) END
               ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
         END;
       WHILE SY = ADDOP DO
         BEGIN LOAD; LATTR := GATTR; LOP := OP;
           INSYMBOL; TERM(FSYS + [ADDOP]); LOAD;
           IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
             CASE LOP OF
     (*+*)     PLUS:
                 BEGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR);
                   IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN
                     GEN0(2(*ADI*))
                   ELSE
                     IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR) THEN
                       GEN0(3(*ADR*))
                     ELSE
                       IF (GATTR.TYPTR^.FORM = LONGINT) AND
                          (LATTR.TYPTR^.FORM = LONGINT) THEN
                         BEGIN GENLDC(2(*DAD*)); GENNR(DECOPS) END
                       ELSE
                         IF (LATTR.TYPTR^.FORM = POWER)
                            AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                           GEN0(28(*UNI*))
                         ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                 END;
     (*-*)     MINUS:
                 BEGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR);
                   IF (LATTR.TYPTR = INTPTR) AND (GATTR.TYPTR = INTPTR) THEN
                     GEN0(21(*SBI*))
                   ELSE
                     IF (LATTR.TYPTR = REALPTR) AND (GATTR.TYPTR = REALPTR)
                       THEN GEN0(22(*SBR*))
                     ELSE
                       IF (GATTR.TYPTR^.FORM = LONGINT) AND
                          (LATTR.TYPTR^.FORM = LONGINT) THEN
                         BEGIN GENLDC(4(*DSB*)); GENNR(DECOPS) END
                       ELSE
                         IF (LATTR.TYPTR^.FORM = POWER)
                             AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                           GEN0(5(*DIF*))
                         ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                 END;
     (*OR*)    OROP:
                 IF (LATTR.TYPTR = BOOLPTR) AND (GATTR.TYPTR = BOOLPTR) THEN
                   GEN0(13(*IOR*))
                 ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
             END (*CASE*)
           ELSE GATTR.TYPTR := NIL
         END (*WHILE*)
     END (*SIMPLEEXPRESSION*) ;

     PROCEDURE MAKEPA(VAR STRGFSP: STP; PAFSP: STP);
       VAR LMIN,LMAX: INTEGER;
     BEGIN
       IF PAFSP^.INXTYPE <> NIL THEN
         BEGIN GETBOUNDS(PAFSP^.INXTYPE,LMIN,LMAX);
           IF LMAX-LMIN+1 <> STRGFSP^.MAXLENG THEN ERROR(129)
         END;
       STRGFSP := PAFSP
     END (*MAKEPA*) ;

   BEGIN (*EXPRESSION*)
     SIMPLEEXPRESSION(FSYS + [RELOP]);
     IF SY = RELOP THEN
       BEGIN
         LSTRING := (GATTR.KIND = CST) AND
                 (STRGTYPE(GATTR.TYPTR) OR (GATTR.TYPTR = CHARPTR));
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
           ELSE LOADADDRESS;
         LATTR := GATTR; LOP := OP;
         INSYMBOL; SIMPLEEXPRESSION(FSYS);
         GSTRING := (GATTR.KIND = CST) AND
                 (STRGTYPE(GATTR.TYPTR) OR (GATTR.TYPTR = CHARPTR));
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
           ELSE LOADADDRESS;
         IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
           IF LOP = INOP THEN
             IF GATTR.TYPTR^.FORM = POWER THEN
               IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET) THEN
                 GEN0(11(*INN*))
               ELSE BEGIN ERROR(129); GATTR.TYPTR := NIL END
             ELSE BEGIN ERROR(130); GATTR.TYPTR := NIL END
           ELSE
             BEGIN
               IF LATTR.TYPTR <> GATTR.TYPTR THEN
                 BEGIN FLOATIT(LATTR.TYPTR,FALSE); STRETCHIT(LATTR.TYPTR) END;
               IF LSTRING THEN
                 BEGIN
                   IF PAOFCHAR(GATTR.TYPTR) THEN
                     IF NOT GATTR.TYPTR^.AISSTRNG THEN
                       BEGIN GEN0(29(*S2P*));
                         MAKEPA(LATTR.TYPTR,GATTR.TYPTR)
                       END
                 END
               ELSE
                 IF GSTRING THEN
                   BEGIN
                     IF PAOFCHAR(LATTR.TYPTR) THEN
                       IF NOT LATTR.TYPTR^.AISSTRNG THEN
                         BEGIN GEN0(80(*S1P*));
                           MAKEPA(GATTR.TYPTR,LATTR.TYPTR)
                         END;
                   END;
               IF (LSTRING AND STRGTYPE(GATTR.TYPTR)) OR
                  (GSTRING AND STRGTYPE(LATTR.TYPTR)) THEN GOTO 1;
               IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                 BEGIN LSIZE := LATTR.TYPTR^.SIZE; (*INVALID FOR LONG INTEGERS*)
                   CASE LATTR.TYPTR^.FORM OF
                     SCALAR:
                       IF LATTR.TYPTR = REALPTR THEN TYPIND := 1
                       ELSE
                         IF LATTR.TYPTR = BOOLPTR THEN TYPIND := 3
                         ELSE TYPIND := 0;
                     POINTER:
                       BEGIN
                         IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131);
                         TYPIND := 0
                       END;
                     LONGINT: TYPIND := 7;
                     POWER:
                       BEGIN
                         IF LOP IN [LTOP,GTOP] THEN ERROR(132);
                         TYPIND := 4
                       END;
                     ARRAYS:
                       BEGIN
                         TYPIND := 6;
                         IF PAOFCHAR(LATTR.TYPTR) THEN
                           IF LATTR.TYPTR^.AISSTRNG THEN
                 1:          TYPIND := 2
                           ELSE
                             BEGIN TYPIND := 5;
                               IF LATTR.TYPTR^.INXTYPE <> NIL THEN
                                 BEGIN
                                   GETBOUNDS(LATTR.TYPTR^.INXTYPE,LMIN,LMAX);
                                   LSIZE := LMAX - LMIN + 1
                                 END
                             END
                         ELSE
                           IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131)
                       END;
                     RECORDS:
                       BEGIN
                         IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131);
                         TYPIND := 6
                       END;
                     FILES:
                       BEGIN ERROR(133); TYPIND := 0 END
                   END;
                   IF TYPIND = 7 THEN
                     BEGIN GENLDC(ORD(LOP)); GENLDC(16(*DCMP*));
                       GENNR(DECOPS)
                     END
                   ELSE
                     CASE LOP OF
                       LTOP: GEN2(53(*LES*),TYPIND,LSIZE);
                       LEOP: GEN2(52(*LEQ*),TYPIND,LSIZE);
                       GTOP: GEN2(49(*GRT*),TYPIND,LSIZE);
                       GEOP: GEN2(48(*GEQ*),TYPIND,LSIZE);
                       NEOP: GEN2(55(*NEQ*),TYPIND,LSIZE);
                       EQOP: GEN2(47(*EQU*),TYPIND,LSIZE)
                     END
                 END
               ELSE ERROR(129)
             END;
         GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR
       END (*SY = RELOP*)
   END (*EXPRESSION*) ;

 (* $I BODYPART.E.TEXT*)

 (*    COPYRIGHT (C) 1978, REGENTS OF THE        *)
 (*    UNIVERSITY OF CALIFORNIA, SAN DIEGO       *)

   PROCEDURE STATEMENT(FSYS: SETOFSYS);
     LABEL 1;
     VAR LCP: CTP; TTOP: DISPRANGE; LLP: LABELP; HEAP: ^INTEGER;

     PROCEDURE ASSIGNMENT(FCP: CTP);
       VAR LATTR: ATTR; CSTRING,PAONLEFT: BOOLEAN; LMIN,LMAX: INTEGER;
     BEGIN SELECTOR(FSYS + [BECOMES],FCP);
       IF SY = BECOMES THEN
         BEGIN LMAX := 0; CSTRING := FALSE;
           IF GATTR.TYPTR <> NIL THEN
             IF (GATTR.ACCESS = INDRCT) OR (GATTR.TYPTR^.FORM > POWER) THEN
               LOADADDRESS;
           PAONLEFT := PAOFCHAR(GATTR.TYPTR);
           LATTR := GATTR;
           INSYMBOL; EXPRESSION(FSYS);
           IF GATTR.KIND = CST THEN
             CSTRING := (GATTR.TYPTR = CHARPTR) OR STRGTYPE(GATTR.TYPTR);
           IF GATTR.TYPTR <> NIL THEN
             IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
             ELSE LOADADDRESS;
           IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
             BEGIN
               IF GATTR.TYPTR = INTPTR THEN
                 IF COMPTYPES(REALPTR,LATTR.TYPTR) THEN
                   BEGIN GEN0(10(*FLT*)); GATTR.TYPTR := REALPTR END;
               IF COMPTYPES(LONGINTPTR,LATTR.TYPTR) THEN
                 BEGIN
                   IF GATTR.TYPTR = INTPTR THEN
                     BEGIN GENLDC(INTSIZE);
                       GATTR.TYPTR := LONGINTPTR
                     END;
                   IF GATTR.TYPTR^.FORM <> LONGINT THEN
                     BEGIN ERROR(129); GATTR.TYPTR := LONGINTPTR END
                 END;
               IF PAONLEFT THEN
                 IF LATTR.TYPTR^.AISSTRNG THEN
                   IF CSTRING AND (GATTR.TYPTR = CHARPTR) THEN
                     GATTR.TYPTR := STRGPTR
                   ELSE
                 ELSE
                   IF LATTR.TYPTR^.INXTYPE <> NIL THEN
                     BEGIN GETBOUNDS(LATTR.TYPTR^.INXTYPE,LMIN,LMAX);
                       LMAX := LMAX - LMIN + 1;
                       IF CSTRING AND (GATTR.TYPTR <> CHARPTR) THEN
                         BEGIN GEN0(80(*S1P*));
                           IF LMAX <> GATTR.TYPTR^.MAXLENG THEN ERROR(129);
                           GATTR.TYPTR := LATTR.TYPTR
                         END
                     END
                   ELSE GATTR.TYPTR := LATTR.TYPTR;
               IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                 CASE LATTR.TYPTR^.FORM OF
                   SUBRANGE: BEGIN
                               IF RANGECHECK THEN
                                 BEGIN
                                   GENLDC(LATTR.TYPTR^.MIN.IVAL);
                                   GENLDC(LATTR.TYPTR^.MAX.IVAL);
                                   GEN0(8(*CHK*))
                                 END;
                               STORE(LATTR)
                             END;
                   POWER:    BEGIN
                               GEN1(32(*ADJ*),LATTR.TYPTR^.SIZE);
                               STORE(LATTR)
                             END;
                   SCALAR,
                   POINTER:  STORE(LATTR);
                   LONGINT: BEGIN
                               GENLDC(LATTR.TYPTR^.SIZE);
                               GENLDC(0(*DAJ*));
                               GENNR(DECOPS);
                               STORE(LATTR)
                             END;
                   ARRAYS:  IF PAONLEFT THEN
                              IF LATTR.TYPTR^.AISSTRNG THEN
                                GEN1(42(*SAS*),LATTR.TYPTR^.MAXLENG)
                              ELSE GEN1(41(*MVB*),LMAX)
                            ELSE GEN1(40(*MOV*),LATTR.TYPTR^.SIZE);
                   RECORDS: GEN1(40(*MOV*),LATTR.TYPTR^.SIZE);
                   FILES:   ERROR(146)
                 END
               ELSE ERROR(129)
             END
         END (*SY = BECOMES*)
       ELSE ERROR(51)
     END (*ASSIGNMENT*) ;

     PROCEDURE GOTOSTATEMENT;
       VAR LLP: LABELP; FOUND: BOOLEAN; TTOP: DISPRANGE;
     BEGIN
       IF NOT GOTOOK THEN ERROR(6);
       IF SY = INTCONST THEN
         BEGIN
           FOUND := FALSE; TTOP := TOP;
           WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP - 1;
           LLP := DISPLAY[TTOP].FLABEL;
           WHILE (LLP <> NIL) AND NOT FOUND DO
             WITH LLP^ DO
               IF LABVAL = VAL.IVAL THEN
                 BEGIN FOUND := TRUE;
                   GENJMP(57(*UJP*),CODELBP)
                 END
               ELSE LLP := NEXTLAB;
           IF NOT FOUND THEN ERROR(167);
           INSYMBOL
         END
       ELSE ERROR(15)
     END (*GOTOSTATEMENT*) ;

     PROCEDURE COMPOUNDSTATEMENT;
     BEGIN
       REPEAT
         REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
         UNTIL NOT (SY IN STATBEGSYS);
         TEST := SY <> SEMICOLON;
         IF NOT TEST THEN INSYMBOL
       UNTIL TEST;
       IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
     END (*COMPOUNDSTATEMENET*) ;

     PROCEDURE IFSTATEMENT;
       VAR LCIX1,LCIX2: LBP; LIC: INTEGER; CONDCOMPILE,NOTHENCLAUSE: BOOLEAN;
     BEGIN
       CONDCOMPILE := FALSE;
       EXPRESSION(FSYS + [THENSY]);
       IF (GATTR.KIND = CST) THEN
         IF (GATTR.TYPTR = BOOLPTR) THEN
           BEGIN CONDCOMPILE := TRUE;
             NOTHENCLAUSE := NOT ODD(GATTR.CVAL.IVAL);
             LIC := IC
           END;
       IF NOT CONDCOMPILE THEN
         BEGIN GENLABEL(LCIX1); GENFJP(LCIX1) END;
       IF SY = THENSY THEN INSYMBOL ELSE ERROR(52);
       STATEMENT(FSYS + [ELSESY]);
       IF CONDCOMPILE THEN
         IF NOTHENCLAUSE THEN IC := LIC
         ELSE LIC := IC;
       IF SY = ELSESY THEN
         BEGIN
           IF NOT CONDCOMPILE THEN
             BEGIN GENLABEL(LCIX2); GENJMP(57(*UJP*),LCIX2); PUTLABEL(LCIX1) END;
           INSYMBOL; STATEMENT(FSYS);
           IF CONDCOMPILE THEN
             BEGIN
               IF NOT NOTHENCLAUSE THEN IC := LIC
             END
           ELSE PUTLABEL(LCIX2)
         END
       ELSE
         IF NOT CONDCOMPILE THEN PUTLABEL(LCIX1)
     END (*IFSTATEMENT*) ;

     PROCEDURE CASESTATEMENT;
       LABEL 1;
       TYPE CIP = ^CASEINFO;
            CASEINFO = RECORD
                         NEXT: CIP;
                         CSSTART: INTEGER;
                         CSLAB: INTEGER
                       END;
       VAR LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU;
           LADDR, LCIX: LBP; NULSTMT, LMIN, LMAX: INTEGER;
     BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]);
       LOAD; GENLABEL(LCIX); GENJMP(57(*UJP*),LCIX);
       LSP := GATTR.TYPTR;
       IF LSP <> NIL THEN
         IF (LSP^.FORM <> SCALAR) OR (LSP = REALPTR) THEN
           BEGIN ERROR(144); LSP := NIL END;
       IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
       FSTPTR := NIL; GENLABEL(LADDR);
       REPEAT
         LPT3 := NIL;
         REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL);
           IF LSP <> NIL THEN
             IF COMPTYPES(LSP,LSP1) THEN
               BEGIN LPT1 := FSTPTR; LPT2 := NIL;
                 WHILE LPT1 <> NIL DO
                   WITH LPT1^ DO
                     BEGIN
                       IF CSLAB <= LVAL.IVAL THEN
                         BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156);
                           GOTO 1
                         END;
                       LPT2 := LPT1; LPT1 := NEXT
                     END;
     1:          NEW(LPT3);
                 WITH LPT3^ DO
                   BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL;
                     CSSTART := IC
                   END;
                 IF LPT2 = NIL THEN FSTPTR := LPT3
                 ELSE LPT2^.NEXT := LPT3
               END
             ELSE ERROR(147);
           TEST := SY <> COMMA;
           IF NOT TEST THEN INSYMBOL
         UNTIL TEST;
         IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
         REPEAT STATEMENT(FSYS + [SEMICOLON])
         UNTIL NOT (SY IN STATBEGSYS);
         IF LPT3 <> NIL THEN
           GENJMP(57(*UJP*),LADDR);
         TEST := SY <> SEMICOLON;
         IF NOT TEST THEN INSYMBOL
       UNTIL TEST OR (SY = ENDSY);
       PUTLABEL(LCIX);
       IF FSTPTR <> NIL THEN
         BEGIN LMAX := FSTPTR^.CSLAB;
           LPT1 := FSTPTR; FSTPTR := NIL;
           REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR;
             FSTPTR := LPT1; LPT1 := LPT2
           UNTIL LPT1 = NIL;
           LMIN := FSTPTR^.CSLAB;
               GEN0(44(*XJP*));
               GENWORD(LMIN); GENWORD(LMAX);
               NULSTMT := IC;
               GENJMP(57(*UJP*),LADDR);
               REPEAT
                 WITH FSTPTR^ DO
                   BEGIN
                     WHILE CSLAB > LMIN DO
                       BEGIN GENWORD(IC-NULSTMT); LMIN := LMIN + 1 END;
                     GENWORD(IC-CSSTART);
                     FSTPTR := NEXT; LMIN := LMIN + 1
                   END
               UNTIL FSTPTR = NIL;
               PUTLABEL(LADDR)
         END;
         IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
     END (*CASESTATEMENT*) ;

     PROCEDURE REPEATSTATEMENT;
       VAR LADDR: LBP;
     BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
       REPEAT
         REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY])
         UNTIL NOT (SY IN STATBEGSYS);
         TEST := SY <> SEMICOLON;
         IF NOT TEST THEN INSYMBOL
       UNTIL TEST;
       IF SY = UNTILSY THEN
         BEGIN INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR)
         END
       ELSE ERROR(53)
     END (*REPEATSTATEMENT*) ;

     PROCEDURE WHILESTATEMENT;
       VAR LADDR, LCIX: LBP;
     BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
       EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX);
       IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
       STATEMENT(FSYS); GENJMP(57(*UJP*),LADDR); PUTLABEL(LCIX)
     END (*WHILESTATEMENT*) ;

     PROCEDURE FORSTATEMENT;
       VAR LATTR: ATTR; LSP: STP;  LSY: SYMBOL;
           LCIX, LADDR: LBP;
     BEGIN
       IF SY = IDENT THEN
         BEGIN SEARCHID(VARS,LCP);
           WITH LCP^, LATTR DO
             BEGIN TYPTR := IDTYPE; KIND := VARBL;
               IF KLASS = ACTUALVARS THEN
                 BEGIN ACCESS := DRCT; VLEVEL := VLEV;
                   DPLMT := VADDR
                 END
               ELSE BEGIN ERROR(155); TYPTR := NIL END
             END;
           IF LATTR.TYPTR <> NIL THEN
             IF (LATTR.TYPTR^.FORM > SUBRANGE)
                OR COMPTYPES(REALPTR,LATTR.TYPTR) THEN
               BEGIN ERROR(143); LATTR.TYPTR := NIL END;
           INSYMBOL
         END
       ELSE
         BEGIN ERROR(2); SKIP(FSYS + [BECOMES,TOSY,DOWNTOSY,DOSY])
         END;
       IF SY = BECOMES THEN
         BEGIN INSYMBOL; EXPRESSION(FSYS + [TOSY,DOWNTOSY,DOSY]);
           IF GATTR.TYPTR <> NIL THEN
             IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144)
               ELSE
                 IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                   BEGIN LOAD;
                     IF LATTR.TYPTR <> NIL THEN
                       IF (LATTR.TYPTR^.FORM = SUBRANGE) AND RANGECHECK THEN
                         BEGIN
                           GENLDC(LATTR.TYPTR^.MIN.IVAL);
                           GENLDC(LATTR.TYPTR^.MAX.IVAL);
                           GEN0(8(*CHK*))
                         END;
                     STORE(LATTR)
                   END
                 ELSE ERROR(145)
         END
       ELSE
         BEGIN ERROR(51); SKIP(FSYS + [TOSY,DOWNTOSY,DOSY]) END;
       GENLABEL(LADDR);
       IF SY IN [TOSY,DOWNTOSY] THEN
         BEGIN LSY := SY; INSYMBOL; EXPRESSION(FSYS + [DOSY]);
           IF GATTR.TYPTR <> NIL THEN
             IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144)
             ELSE
               IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                 BEGIN LOAD;
                   IF LATTR.TYPTR <> NIL THEN
                     IF (LATTR.TYPTR^.FORM = SUBRANGE) AND RANGECHECK THEN
                       BEGIN
                         GENLDC(LATTR.TYPTR^.MIN.IVAL);
                         GENLDC(LATTR.TYPTR^.MAX.IVAL);
                         GEN0(8(*CHK*))
                       END;
                   GEN2(56(*STR*),0,LC); PUTLABEL(LADDR);
                   GATTR := LATTR; LOAD; GEN2(54(*LOD*),0,LC);
                   LC := LC + INTSIZE;
                   IF LC > LCMAX THEN LCMAX := LC;
                   IF LSY = TOSY THEN GEN2(52(*LEQ*),0,INTSIZE)
                   ELSE GEN2(48(*GEQ*),0,INTSIZE);
                 END
               ELSE ERROR(145)
         END
       ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END;
       GENLABEL(LCIX); GENJMP(33(*FJP*),LCIX);
       IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
       STATEMENT(FSYS);
       GATTR := LATTR; LOAD; GENLDC(1);
       IF LSY = TOSY THEN GEN0(2(*ADI*)) ELSE GEN0(21(*SBI*));
       STORE(LATTR); GENJMP(57(*UJP*),LADDR); PUTLABEL(LCIX);
       LC := LC - INTSIZE
     END (*FORSTATEMENT*) ;


     PROCEDURE WITHSTATEMENT;
       VAR LCP: CTP; LCNT1,LCNT2: DISPRANGE;
     BEGIN LCNT1 := 0; LCNT2 := 0;
       REPEAT
         IF SY = IDENT THEN
           BEGIN SEARCHID(VARS + [FIELD],LCP); INSYMBOL END
         ELSE BEGIN ERROR(2); LCP := UVARPTR END;
         SELECTOR(FSYS + [COMMA,DOSY],LCP);
         IF GATTR.TYPTR <> NIL THEN
           IF GATTR.TYPTR^.FORM = RECORDS THEN
             IF TOP < DISPLIMIT THEN
               BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1;
                 WITH DISPLAY[TOP] DO
                   BEGIN FNAME := GATTR.TYPTR^.FSTFLD END;
                 IF GATTR.ACCESS = DRCT THEN
                   WITH DISPLAY[TOP] DO
                     BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL;
                       CDSPL := GATTR.DPLMT
                     END
                 ELSE
                   BEGIN LOADADDRESS; GEN2(56(*STR*),0,LC);
                     WITH DISPLAY[TOP] DO
                       BEGIN OCCUR := VREC; VDSPL := LC END;
                     LC := LC + PTRSIZE; LCNT2 := LCNT2 + PTRSIZE;
                     IF LC > LCMAX THEN LCMAX := LC
                   END
               END
             ELSE ERROR(250)
           ELSE ERROR(140);
         TEST := SY <> COMMA;
         IF NOT TEST THEN INSYMBOL
       UNTIL TEST;
       IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
       STATEMENT(FSYS);
       TOP := TOP - LCNT1; LC := LC - LCNT2;
     END (*WITHSTATEMENT*) ;

   BEGIN (*STATEMENT*)
     STMTLEV := STMTLEV + 1;
     IF SY = INTCONST THEN (*LABEL*)
       BEGIN TTOP := TOP;
         WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP-1;
         LLP := DISPLAY[TTOP].FLABEL;
         WHILE LLP <> NIL DO
           WITH LLP^ DO
             IF LABVAL = VAL.IVAL THEN
               BEGIN
                 IF CODELBP^.DEFINED THEN ERROR(165);
                 PUTLABEL(CODELBP); GOTO 1
               END
             ELSE LLP := NEXTLAB;
         ERROR(167);
   1:    INSYMBOL;
         IF SY = COLON THEN INSYMBOL ELSE ERROR(5)
       END;
     IF DEBUGGING THEN
       BEGIN GEN1(85(*BPT*),SCREENDOTS+1); BPTONLINE := TRUE END;
     IF NOT (SY IN FSYS + [IDENT]) THEN
       BEGIN ERROR(6); SKIP(FSYS) END;
     IF SY IN STATBEGSYS + [IDENT] THEN
       BEGIN MARK(HEAP); (*FOR LABEL CLEANUP*)
         CASE SY OF
           IDENT:    BEGIN SEARCHID(VARS + [FIELD,FUNC,PROC],LCP);
                       INSYMBOL;
                       IF LCP^.KLASS = PROC THEN CALL(FSYS,LCP)
                       ELSE ASSIGNMENT(LCP)
                     END;
           BEGINSY:  BEGIN INSYMBOL; COMPOUNDSTATEMENT END;
           GOTOSY:   BEGIN INSYMBOL; GOTOSTATEMENT END;
           IFSY:     BEGIN INSYMBOL; IFSTATEMENT END;
           CASESY:   BEGIN INSYMBOL; CASESTATEMENT END;
           WHILESY:  BEGIN INSYMBOL; WHILESTATEMENT END;
           REPEATSY: BEGIN INSYMBOL; REPEATSTATEMENT END;
           FORSY:    BEGIN INSYMBOL; FORSTATEMENT END;
           WITHSY:   BEGIN INSYMBOL; WITHSTATEMENT END
         END;
         RELEASE(HEAP);
         IF IC + 100 > MAXCODE THEN
           BEGIN ERROR(253); IC := 0 END;
         IF NOT (SY IN [SEMICOLON,ENDSY,ELSESY,UNTILSY]) THEN
           BEGIN ERROR(6); SKIP(FSYS) END
       END;
     STMTLEV := STMTLEV - 1
   END (*STATEMENT*) ;

 PROCEDURE BODY;

 VAR LLC1,EXITIC: ADDRRANGE;  LCP: CTP;  LOP: OPRANGE;
      LLP: LABELP;  LMIN,LMAX: INTEGER;  JTINX: JTABRANGE;
      DUMMYVAR: ARRAY[0..0] OF INTEGER; (*FOR PRETTY DISPLAY OF STACK AND HEAP*)

 BEGIN
   IF (NOSWAP) AND (STARTINGUP) THEN
     BEGIN
       DECLARATIONPART(FSYS); (* BRING IN DECLARATIONPART *)
       EXIT(BODYPART);
     END;
   NEXTJTAB := 1;
   IF NOISY THEN
     BEGIN WRITELN(OUTPUT);
       IF NOT NOSWAP THEN (*MUST ADJUST DISPLAY OF STACK AND HEAP*)
         UNITWRITE(3,DUMMYVAR[-1600],35);
       DUMMYVAR[0]:=MEMAVAIL;
       IF DUMMYVAR[0] < SMALLESTSPACE THEN SMALLESTSPACE:=DUMMYVAR[0];
       IF FPROCP <> NIL THEN
           WRITELN(OUTPUT,FPROCP^.NAME,' [',DUMMYVAR[0]:5,' words]');
       WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
     END;
   IF FPROCP <> NIL THEN
     BEGIN
       LLC1 := FPROCP^.LOCALLC; LCP := FPROCP^.NEXT;
       WHILE LCP <> NIL DO
         WITH LCP^ DO
           BEGIN
               IF IDTYPE <> NIL THEN
                 IF (KLASS = ACTUALVARS) THEN
                   IF (IDTYPE^.FORM > POWER) THEN
                     BEGIN LLC1 := LLC1 - PTRSIZE;
                       GEN2(50(*LDA*),0,VADDR);
                       GEN2(54(*LOD*),0,LLC1);
                       IF PAOFCHAR(IDTYPE) THEN
                         WITH IDTYPE^ DO
                           IF AISSTRNG THEN GEN1(42(*SAS*),MAXLENG)
                           ELSE
                             IF INXTYPE <> NIL THEN
                               BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                                 GEN1(41(*MVB*),LMAX - LMIN + 1)
                               END
                             ELSE
                       ELSE GEN1(40(*MOV*),IDTYPE^.SIZE)
                     END
                   ELSE LLC1 := LLC1 - IDTYPE^.SIZE
                 ELSE
                   IF KLASS = FORMALVARS THEN LLC1 := LLC1 - PTRSIZE;
             LCP := NEXT
           END;
     END;
   STARTDOTS := SCREENDOTS;
   LCMAX := LC;
   LLP := DISPLAY[TOP].FLABEL;
   WHILE LLP <> NIL DO
     BEGIN GENLABEL(LLP^.CODELBP);
       LLP := LLP^.NEXTLAB
     END;
   IF NOT INMODULE THEN
     IF LEVEL = 1 THEN
       BEGIN LCP := USINGLIST;
         WHILE LCP <> NIL DO
           BEGIN
             IF LCP^.SEGID >= 0 THEN
               BEGIN GENLDC(LCP^.SEGID); GEN1(30(*CSP*),21(*GETSEG*)) END;
             LCP := LCP^.NEXT
           END;
         IF USERINFO.STUPID THEN
             GEN2(77(*CXP*),6(*TURTLE*),1(*INIT*))
       END;
   LCP := DISPLAY[TOP].FFILE;
   WHILE LCP <> NIL DO
     WITH LCP^,IDTYPE^ DO
       BEGIN
         GEN2(50(*LDA*),0,VADDR);
         GEN2(50(*LDA*),0,VADDR+FILESIZE);
         IF FILTYPE = NIL THEN GENLDC(-1)
         ELSE
           IF IDTYPE = INTRACTVPTR THEN GENLDC(0)
           ELSE
             IF FILTYPE = CHARPTR THEN GENLDC(-2)
             ELSE GENLDC(FILTYPE^.SIZE);
         GEN2(77(*CXP*),0(*SYS*),3(*FINIT*));
         LCP := NEXT
       END;
   IF (LEVEL = 1) AND NOT SYSCOMP THEN
     GEN1(85(*BPT*),SCREENDOTS+1);
   REPEAT
     REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
     UNTIL NOT (SY IN STATBEGSYS);
     TEST := SY <> SEMICOLON;
     IF NOT TEST THEN INSYMBOL
   UNTIL TEST;
   IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13);
   EXITIC := IC;
   LCP := DISPLAY[TOP].FFILE;
   WHILE LCP <> NIL DO
     WITH LCP^ DO
       BEGIN
         GEN2(50(*LDA*),0,VADDR);
         GENLDC(0); GEN2(77(*CXP*),0(*SYS*),6(*FCLOSE*));
         LCP := NEXT
       END;
   IF NOT INMODULE THEN
     IF LEVEL = 1 THEN
       BEGIN
         LCP := USINGLIST;
         WHILE LCP <> NIL DO
           BEGIN
             IF LCP^.SEGID >= 0 THEN
               BEGIN GENLDC(LCP^.SEGID); GEN1(30(*CSP*),22(*RELSEG*)) END;
             LCP := LCP^.NEXT
           END
       END;
   IF FPROCP = NIL THEN GEN0(86(*XIT*))
   ELSE
     BEGIN
       IF FPROCP^.PFLEV = 0 THEN LOP := 65(*RBP*)
       ELSE LOP := 45(*RNP*);
       IF FPROCP^.IDTYPE = NIL THEN GEN1(LOP,0)
       ELSE GEN1(LOP,FPROCP^.IDTYPE^.SIZE)
     END;
   LLP := DISPLAY[TOP].FLABEL;  (* CHECK UNDEFINED LABELS *)
   WHILE LLP <> NIL DO
     WITH LLP^,CODELBP^ DO
       BEGIN
         IF NOT DEFINED THEN
           IF REFLIST <> MAXADDR THEN ERROR(168);
         LLP := NEXTLAB
       END;
   JTINX := NEXTJTAB - 1;
   IF ODD(IC) THEN IC := IC + 1;
   WHILE JTINX > 0 DO
     BEGIN GENWORD(IC-JTAB[JTINX]); JTINX := JTINX-1 END;
   IF FPROCP = NIL THEN
     BEGIN GENWORD((LCMAX-LCAFTERMARKSTACK)*2); GENWORD(0) END
   ELSE
     WITH FPROCP^ DO
       BEGIN GENWORD((LCMAX-LOCALLC)*2);
         GENWORD((LOCALLC-LCAFTERMARKSTACK)*2)
       END;
   GENWORD(IC-EXITIC); GENWORD(IC);
   GENBYTE(CURPROC); GENBYTE(LEVEL-1);
   IF NOT CODEINSEG THEN
     BEGIN CODEINSEG := TRUE;
       SEGTABLE[SEG].DISKADDR := CURBLK
     END;
   WRITECODE(FALSE);
   SEGINX := SEGINX + IC;
   PROCTABLE[CURPROC] := SEGINX - 2
 END (*BODY*) ;

 BEGIN (*BODYPART*)
   BODY
 END ;

 (* $I UNITPART.TEXT*)

     (******************************************************************)
     (*                                                                *)
     (*  Copyright (c) l978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 SEGMENT PROCEDURE WRITELINKERINFO(DECSTUFF:BOOLEAN);
	
   TYPE
     LITYPES = (EOFMARK,MODDULE,GLOBREF,PUBBLIC,PRIVVATE,CONNSTANT,GLOBDEF,
                PUBLICDEF,CONSTDEF,EXTPROC,EXTFUNC,SSEPPROC,SSEPFUNC,
                SEPPREF,SEPFREF);
     OPFORMAT = (WORD, BYTE, BIG);
     LIENTRY = RECORD
                 LINAME: ALPHA;
                 CASE LITYPE: LITYPES OF
                   MODDULE,
                   PUBBLIC,
                   PRIVVATE,
                   SEPPREF,
                   SEPFREF:          (FORMAT: OPFORMAT;
                                      NREFS: INTEGER;
                                      NWORDS: INTEGER);
                   CONSTDEF:         (CONSTANT: INTEGER);
                   PUBLICDEF:        (BASEOFFSET: INTEGER);
                   EXTPROC,EXTFUNC,
                   SSEPPROC,SSEPFUNC:(PROCNUM: INTEGER;
                                      NPARAMS: INTEGER;
                                      RANGE: ^INTEGER)
               END;

   VAR FCP,LCP: CTP; CURRENTBLOCK: INTEGER; I: NONRESIDENT;
       EXTNAME: ALPHA; FIC: ADDRRANGE;
       LIREC: LIENTRY;

   PROCEDURE GETREFS(ID,LENGTH: INTEGER);
     VAR LIC: ADDRRANGE; J,MAX,BLOCKCOUNT,COUNT: INTEGER;

     PROCEDURE GETNEXTBLOCK;
     BEGIN
       CURRENTBLOCK := CURRENTBLOCK + 1;
       IF CURRENTBLOCK > REFBLK THEN CURRENTBLOCK := 0;
       IF BLOCKREAD(REFFILE,REFLIST^,1,CURRENTBLOCK) <> 1 THEN;
     END (*GETNEXTBLOCK*) ;

   BEGIN (*GETREFS*)
     IF (NREFS = 1) AND (REFBLK = 0) THEN EXIT(GETREFS);
     COUNT := 0;
     FOR BLOCKCOUNT := 0 TO REFBLK DO
       BEGIN
         IF CURRENTBLOCK < REFBLK THEN MAX := REFSPERBLK ELSE MAX := NREFS-1;
         FOR J := 1 TO MAX DO
           IF ID = REFLIST^[J].KEY THEN
             BEGIN GENWORD(REFLIST^[J].OFFSET); COUNT := COUNT + 1 END;
         IF BLOCKCOUNT < REFBLK THEN GETNEXTBLOCK;
       END;
     LIC := IC; IC := FIC; GENWORD(COUNT); IC := LIC;
     (*NOW FILL REST OF 8-WORD RECORD*)
     FOR J := 1 TO ((8 - (COUNT MOD 8)) MOD 8) DO GENWORD(0)
   END (* GETREFS *) ;

   PROCEDURE GLOBALSEARCH(FCP: CTP);
     VAR NEEDEDBYLINKER: BOOLEAN;

   BEGIN
     NEEDEDBYLINKER := TRUE;
     WITH LIREC,FCP^ DO
       CASE KLASS OF
         TYPES: NEEDEDBYLINKER := FALSE;
         KONST: IF (IDTYPE^.SIZE = 1) AND NOT INMODULE THEN
                  BEGIN LITYPE := CONSTDEF;
                    CONSTANT := VALUES.IVAL
                  END
                ELSE NEEDEDBYLINKER := FALSE;
         FORMALVARS,
         ACTUALVARS:
                BEGIN
                  IF INMODULE THEN
                    BEGIN
                      IF PUBLIC THEN
                        BEGIN LITYPE := PUBBLIC;
                          NWORDS := 0
                        END
                      ELSE
                        BEGIN LITYPE := PRIVVATE;
                          IF KLASS = FORMALVARS THEN
                            NWORDS := PTRSIZE
                          ELSE
                            NWORDS := IDTYPE^.SIZE
                        END;
                      FORMAT := BIG
                    END
                  ELSE
                    BEGIN LITYPE := PUBLICDEF;
                      BASEOFFSET := VADDR
                    END
                END;
         FIELD: NEEDEDBYLINKER := FALSE;
         PROC,
         FUNC:  BEGIN
                  IF PFDECKIND = DECLARED THEN
                    IF PFKIND = ACTUAL THEN
                      IF KLASS = PROC THEN
                        IF EXTURNAL THEN
                          IF SEPPROC THEN LITYPE := SEPPREF
                          ELSE LITYPE := EXTPROC
                        ELSE
                          IF SEPPROC THEN
                            LITYPE := SSEPPROC
                          ELSE NEEDEDBYLINKER := FALSE
                      ELSE (*KLASS = FUNC*)
                        IF EXTURNAL THEN
                          IF SEPPROC THEN LITYPE := SEPFREF
                          ELSE LITYPE := EXTFUNC
                        ELSE
                          IF SEPPROC THEN
                            LITYPE := SSEPFUNC
                          ELSE NEEDEDBYLINKER := FALSE
                    ELSE NEEDEDBYLINKER := FALSE
                  ELSE NEEDEDBYLINKER := FALSE;
                  IF NEEDEDBYLINKER THEN
                    BEGIN
                      LCP := NEXT; NPARAMS := 0;
                      WHILE LCP <> NIL DO
                        BEGIN
                          WITH LCP^ DO
                            IF KLASS = FORMALVARS THEN
                              NPARAMS := NPARAMS + PTRSIZE
                            ELSE
                              IF KLASS = ACTUALVARS THEN
                                IF IDTYPE^.FORM <= POWER THEN
                                  NPARAMS := NPARAMS + IDTYPE^.SIZE
                                ELSE NPARAMS := NPARAMS + PTRSIZE;
                          LCP := LCP^.NEXT
                        END;
                      IF LITYPE IN [SEPPREF,SEPFREF] THEN
                        BEGIN FORMAT := BYTE; NWORDS := NPARAMS END
                      ELSE
                        BEGIN PROCNUM := PFNAME; RANGE := NIL END
                    END
                  END (*PROC,FUNC*);
         MODULE:  BEGIN
                    IF NOT INMODULE THEN NEEDEDBYLINKER := FALSE
                    ELSE
                      BEGIN LITYPE := MODDULE; NWORDS := 0; FORMAT := BYTE END
                  END
       END (*CASE,WITH*);
     IF NEEDEDBYLINKER THEN
       IF SEGTABLE[SEG].SEGKIND = 2 (*SEGPROC*) THEN
         WITH LIREC DO
           IF (LITYPE = CONSTDEF) OR (LITYPE = PUBLICDEF) THEN
             NEEDEDBYLINKER := FALSE;
     IF NEEDEDBYLINKER THEN
       WITH LIREC DO
         BEGIN LINAME := FCP^.NAME;
           FOR LGTH := 1 TO 8 DO GENBYTE(ORD(LINAME[LGTH]));
           GENWORD(ORD(LITYPE));
           CASE LITYPE OF
             MODDULE,
             PUBBLIC,
             PRIVVATE,
             SEPPREF,SEPFREF: BEGIN
                                GENWORD(ORD(FORMAT));
                                FIC := IC; GENWORD(0);
                                GENWORD(NWORDS);
                                IF LITYPE = MODDULE THEN GETREFS(FCP^.SEGID,1)
                                ELSE
                                 IF LITYPE IN [SEPPREF,SEPFREF] THEN
                                   GETREFS(-FCP^.PFNAME,1)
                                 ELSE GETREFS(FCP^.VADDR + 32,FCP^.IDTYPE^.SIZE);
                              END;
             CONSTDEF: BEGIN  GENWORD(CONSTANT); GENWORD(0); GENWORD(0) END;
             PUBLICDEF: BEGIN GENWORD(BASEOFFSET); GENWORD(0); GENWORD(0) END;
             EXTPROC,EXTFUNC:     BEGIN
                                    GENWORD(PROCNUM);
                                    GENWORD(NPARAMS);
                                    GENWORD(ORD(RANGE))
                                  END;
             SSEPPROC,SSEPFUNC:   BEGIN
                                    GENWORD(PROCNUM);
                                    GENWORD(NPARAMS);
                                    GENWORD(ORD(RANGE));
                                    FOR LGTH := 1 TO 8 DO
                                      GENBYTE(ORD(LINAME[LGTH]));
                                    IF LITYPE = SSEPPROC THEN
                                      GENWORD(ORD(SEPPREF))
                                    ELSE GENWORD(ORD(SEPFREF));
                                    GENWORD(ORD(BYTE));
                                    FIC := IC; GENWORD(0); GENWORD(NPARAMS);
                                    GETREFS(-PROCNUM,1)
                                  END
           END(*CASE*)
         END(*WITH*);
     IF IC >= 1024 THEN BEGIN WRITECODE(FALSE); IC := 0 END;

     IF FCP^.LLINK <> NIL THEN GLOBALSEARCH(FCP^.LLINK);
     IF FCP^.RLINK <> NIL THEN GLOBALSEARCH(FCP^.RLINK)

   END (*GLOBALSEARCH*);

 BEGIN (*WRITELINKERINFO*)
   IC := 0;
   IF CODEINSEG THEN ERROR(399);
   IF INMODULE THEN
       CURRENTBLOCK := REFBLK;
   IF DECSTUFF THEN (*SKIP IF NO DECLARATIONPART LINKER INFO*)
     BEGIN FCP := DISPLAY[GLEV].FNAME;
       IF FCP <> NIL THEN GLOBALSEARCH(FCP)
     END;
   (*NOW DO NONRESIDENT PROCS*)
   WITH LIREC DO
     FOR I := SEEK TO DECOPS DO
       IF PFNUMOF[I] <> 0 THEN
         BEGIN
           CASE I OF
             SEEK:       BEGIN LINAME := 'FSEEK   '; NPARAMS := 2 END;
             FREADREAL:  BEGIN LINAME := 'FREADREA'; NPARAMS := 2 END;
             FWRITEREAL: BEGIN LINAME := 'FWRITERE'; NPARAMS := 5 END;
             FREADDEC:   BEGIN LINAME := 'FREADDEC'; NPARAMS := 3 END;
             FWRITEDEC:  BEGIN LINAME := 'FWRITEDE'; NPARAMS := 10 END;
             DECOPS:     BEGIN LINAME := 'DECOPS  '; NPARAMS := 0 END;
           END;
           FOR LGTH := 1 TO 8 DO GENBYTE(ORD(LINAME[LGTH]));
           IF SEPPROC THEN
             BEGIN GENWORD(ORD(SEPPREF));
               GENWORD(ORD(BYTE)); FIC := IC; GENWORD(0); GENWORD(NPARAMS);
               GETREFS(-PFNUMOF[I],1)
             END
           ELSE
             BEGIN GENWORD(ORD(EXTPROC));
               GENWORD(PFNUMOF[I]); GENWORD(NPARAMS); GENWORD(0)
             END;
           PFNUMOF[I] := 0;
         END;
   (* NOW DO EOFMARK END-RECORD*)
   FOR LGTH := 1 TO 8 DO GENBYTE(ORD(' '));
   GENWORD(ORD(EOFMARK)); GENWORD(LCMAX);
   GENWORD(0);GENWORD(0);
   WRITECODE(TRUE);
   CLINKERINFO := FALSE;
   IF DECSTUFF THEN DLINKERINFO := FALSE
 END (*WRITELINKERINFO*);

 SEGMENT PROCEDURE UNITPART(FSYS: SETOFSYS);
   VAR UMARKP: TESTP;

   PROCEDURE OPENREFFILE;
   BEGIN
     REWRITE(REFFILE,'*SYSTEM.INFO[*]');
     IF IORESULT <> 0 THEN ERROR(402)
   END (* OPENREFFILE *) ;

   PROCEDURE UNITDECLARATION(FSYS: SETOFSYS; VAR UMARKP:TESTP);
     VAR LCP: CTP; FOUND: BOOLEAN; LLEXSTK: LEXSTKREC;
   BEGIN
     IF INMODULE THEN ERROR(182 (* NESTED MODULES NOT ALLOWED *));
     IF CODEINSEG THEN
       BEGIN ERROR(399); SEGINX := 0; CURBYTE := 0 END;
     WITH LLEXSTK DO
       BEGIN
         DOLDTOP := TOP;
         DOLDLEV := LEVEL;
         POLDPROC := CURPROC;
         SOLDPROC := NEXTPROC;
         DOLDSEG := SEG;
         DLLC := LC;
         PREVLEXSTACKP := TOS
       END;
     SEG := NEXTSEG;
     NEXTSEG := NEXTSEG + 1;
     IF NEXTSEG > MAXSEG THEN ERROR(250);
     NEXTPROC := 1;
     PUBLICPROCS := FALSE;
     INMODULE := TRUE;
     INSYMBOL;
     IF SY <> IDENT THEN ERROR(2)
     ELSE
       BEGIN FOUND := FALSE;
         LCP := MODPTR;
         WHILE (LCP <> NIL) AND NOT FOUND DO
           IF LCP^.NAME <> ID THEN LCP := LCP^.NEXT
           ELSE BEGIN FOUND := TRUE; ERROR(101) END;
         IF NOT FOUND THEN
           BEGIN NEW(LCP,MODULE);
             WITH LCP^ DO
               BEGIN NAME := ID; IDTYPE := NIL; NEXT := MODPTR;
                 KLASS := MODULE; SEGID := SEG
               END;
             MODPTR := LCP
           END;
       END;
     SEGTABLE[SEG].SEGNAME := ID;
     MARK(UMARKP);
     NEW(REFLIST);
     NEW(TOS);
     TOS^ := LLEXSTK;
     LEVEL := 1;
     IF TOP < DISPLIMIT THEN
       BEGIN TOP := TOP +1;
         WITH DISPLAY[TOP] DO
           BEGIN FNAME := NIL; FFILE := NIL; FLABEL := NIL; OCCUR := BLCK END;
         IF LCP <> NIL THEN ENTERID(LCP)
       END
     ELSE ERROR(250);
     INSYMBOL;
     IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
   END (*UNITDECLARATION*) ;

 BEGIN (*UNITPART*)
   OPENREFFILE;
   REPEAT
     RESET(REFFILE); NREFS := 1; REFBLK := 0;
     IF (SY = SEPARATSY) THEN
       BEGIN SEPPROC := TRUE;
         INSYMBOL; IF SY <> UNITSY THEN ERROR(24)
       END
     ELSE
       SEPPROC := FALSE;
     UNITDECLARATION(FSYS,UMARKP);
     IF SEPPROC THEN SEGTABLE[SEG].SEGKIND := 4 ELSE SEGTABLE[SEG].SEGKIND := 3;
     SEGTABLE[SEG].TEXTADDR := CURBLK;
     WRITETEXT;
     IF SY = INTERSY THEN INSYMBOL
     ELSE ERROR(22);
     ININTERFACE := TRUE;
     DECLARATIONPART(FSYS);
     IF PUBLICPROCS THEN
       BEGIN
         ININTERFACE := FALSE;
         IF SY <> IMPLESY THEN BEGIN ERROR(23); SKIP(FSYS - STATBEGSYS) END
         ELSE INSYMBOL;
         BLOCK(FSYS - [SEPARATSY,UNITSY,INTERSY,IMPLESY]);
         IF REFBLK > 0 THEN
           IF BLOCKWRITE(REFFILE,REFLIST^,1,REFBLK) <> 1 THEN ERROR(402);
         WRITELINKERINFO(TRUE);
       END
     ELSE
       BEGIN DLINKERINFO := FALSE;
         WITH SEGTABLE[SEG] DO
           BEGIN CODELENG := 0; DISKADDR :=CURBLK; SEGKIND := 0 END;
       END;
     SEPPROC := FALSE; (*FALSE WHENEVER NOT INMODULE*)
     INMODULE := FALSE;
     IF SY = ENDSY THEN INSYMBOL
     ELSE BEGIN ERROR(13); SKIP(FSYS) END;
     IF SY <> PERIOD THEN
       IF SY = SEMICOLON THEN INSYMBOL
       ELSE ERROR(14);
     WITH TOS^ DO
         BEGIN
           TOP := DOLDTOP;
           LEVEL := DOLDLEV;
           CURPROC := POLDPROC;
           NEXTPROC := SOLDPROC;
           SEG := DOLDSEG;
           LC := DLLC;
         END;
     TOS := TOS^.PREVLEXSTACKP;
     RELEASE(UMARKP)
   UNTIL NOT (SY IN [UNITSY,SEPARATSY]);
   CLOSE(REFFILE)
 END (*UNITPART*);

 (* $I PROCS.A.TEXT*)

     (******************************************************************)
     (*                                                                *)
     (*  Copyright (c) l978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 PROCEDURE ERROR(*ERRORNUM: INTEGER*);
   VAR CH: CHAR; ERRSTART: INTEGER;
       A: PACKED ARRAY [0..179] OF CHAR;
 BEGIN
   WITH USERINFO DO
     IF (ERRSYM <> SYMCURSOR) OR (ERRBLK <> SYMBLK) THEN
       BEGIN ERRBLK := SYMBLK;
         ERRSYM := SYMCURSOR; ERRNUM := ERRORNUM;
         IF STUPID THEN CH := 'E'
         ELSE
           BEGIN
             IF NOISY THEN WRITELN(OUTPUT)
             ELSE
               IF LIST AND (ERRORNUM <= 400) THEN
                 EXIT(ERROR);
             IF LINESTART = 0 THEN
               WRITE(OUTPUT,SYMBUFP^:SYMCURSOR)
             ELSE
               BEGIN
                 ERRSTART := SCAN(-(LINESTART-1),=CHR(EOL),
                                     SYMBUFP^[LINESTART-2])+LINESTART-1;
                 MOVELEFT(SYMBUFP^[ERRSTART],A[0],SYMCURSOR-ERRSTART);
                 WRITE(OUTPUT,A:SYMCURSOR-ERRSTART)
               END;
             WRITELN(OUTPUT,' <<<<');
             WRITE(OUTPUT,'Line ',SCREENDOTS,', error ',ERRORNUM:0,':');
             IF NOISY THEN
               WRITE(OUTPUT,' <sp>(continue), <esc>(terminate), E(dit');
             WRITE(OUTPUT,CHR(7));
             REPEAT READ(KEYBOARD,CH)
             UNTIL (CH = ' ') OR (CH = 'E') OR (CH = 'e') OR (CH = ALTMODE)
           END;
         IF (CH = 'E') OR (CH = 'e') THEN
           BEGIN ERRBLK := SYMBLK-2; EXIT(PASCALCOMPILER) END;
         IF (ERRORNUM > 400) OR (CH = CHR(27)) THEN
           BEGIN ERRBLK := 0; EXIT(PASCALCOMPILER) END;
         WRITELN(OUTPUT);
         IF NOISY THEN
           WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
       END
 END (*ERROR*) ;

 PROCEDURE GETNEXTPAGE;
 BEGIN SYMCURSOR := 0; LINESTART := 0;
   IF USING THEN
     BEGIN
       IF USEFILE = WORKCODE THEN
         BEGIN
           IF BLOCKREAD(USERINFO.WORKCODE^,SYMBUFP^,2,SYMBLK) <> 2 THEN
             USING := FALSE
         END
       ELSE
         IF USEFILE = SYSLIBRARY THEN
           IF BLOCKREAD(LIBRARY,SYMBUFP^,2,SYMBLK) <> 2 THEN
             USING := FALSE;
       IF NOT USING THEN
         BEGIN
           SYMBLK := PREVSYMBLK; SYMCURSOR := PREVSYMCURSOR;
           LINESTART := PREVLINESTART
         END
     END;
   IF NOT USING THEN
     BEGIN
       IF INCLUDING THEN
         IF BLOCKREAD(INCLFILE,SYMBUFP^,2,SYMBLK) <> 2 THEN
           BEGIN CLOSE(INCLFILE); INCLUDING := FALSE;
             SYMBLK := OLDSYMBLK; SYMCURSOR := OLDSYMCURSOR;
             LINESTART := OLDLINESTART
           END
     END;
   IF NOT (INCLUDING OR USING) THEN
     IF BLOCKREAD(USERINFO.WORKSYM^,SYMBUFP^,2,SYMBLK) <> 2 THEN
       ERROR(401);
   IF SYMCURSOR = 0 THEN
     BEGIN
       IF INMODULE THEN
         IF ININTERFACE AND NOT USING THEN WRITETEXT;
       IF SYMBUFP^[0] = CHR(16(*DLE*)) THEN
        SYMCURSOR := 2
     END;
   SYMBLK := SYMBLK+2
 END (*GETNEXTPAGE*) ;

 (*$I+*)
 PROCEDURE PRINTLINE;
   VAR DORLEV,STARORC: CHAR; LENG: INTEGER;
       A: PACKED ARRAY [0..99] OF CHAR;
 BEGIN STARORC := ':';
   IF DP THEN DORLEV := 'D'
   ELSE DORLEV := CHR((BEGSTMTLEV MOD 10) + ORD('0'));
   IF BPTONLINE THEN STARORC := '*';
   WRITE(LP,SCREENDOTS:6,SEG:4,CURPROC:5,
             STARORC,DORLEV,LINEINFO:6,' ');
   LENG := SYMCURSOR-LINESTART;
   IF LENG > 100 THEN LENG := 100;
   MOVELEFT(SYMBUFP^[LINESTART],A,LENG);
   IF A[0] = CHR(16(*DLE*)) THEN
     BEGIN
       IF A[1] > ' ' THEN
         WRITE(LP,' ':ORD(A[1])-ORD(' '));
       LENG := LENG-2;
       MOVELEFT(A[2],A,LENG)
     END;
   A[LENG-1] := CHR(EOL); (*JUST TO MAKE SURE*)
   WRITE(LP,A:LENG);
   WITH USERINFO DO
     IF (ERRBLK = SYMBLK) AND (ERRSYM > LINESTART) THEN
       WRITELN(LP,'>>>>>> Error # ',ERRNUM)
 END (*PRINTLINE*) ;
 (*$I-*)

 PROCEDURE ENTERID(*FCP: CTP*);
   VAR LCP,LCP1: CTP; I: INTEGER;
 BEGIN LCP := DISPLAY[TOP].FNAME;
   IF LCP = NIL THEN DISPLAY[TOP].FNAME := FCP
   ELSE
     BEGIN I := TREESEARCH(LCP,LCP1,FCP^.NAME);
       WHILE I = 0 DO
         BEGIN ERROR(101);
           IF LCP1^.RLINK = NIL THEN I := 1
           ELSE I := TREESEARCH(LCP1^.RLINK,LCP1,FCP^.NAME)
         END;
       IF I = 1 THEN LCP1^.RLINK := FCP ELSE LCP1^.LLINK := FCP
     END;
   FCP^.LLINK := NIL; FCP^.RLINK := NIL
 END (*ENTERID*) ;

 PROCEDURE INSYMBOL; (* COMPILER VERSION 3.4 06-NOV-76 *)
   LABEL 1;
   VAR LVP: CSP; X: INTEGER;

 PROCEDURE CHECKEND;
 BEGIN (* CHECKS FOR THE END OF THE PAGE *)
   SCREENDOTS := SCREENDOTS+1;
   SYMCURSOR := SYMCURSOR + 1;
   IF NOISY THEN
     BEGIN WRITE(OUTPUT,'.');
       IF (SCREENDOTS-STARTDOTS) MOD 50 = 0 THEN
         BEGIN WRITELN(OUTPUT);
           WRITE(OUTPUT,'<',SCREENDOTS:4,'>')
         END
     END;
   IF LIST THEN PRINTLINE;
   BPTONLINE := FALSE;
   IF SYMBUFP^[SYMCURSOR]=CHR(0) THEN GETNEXTPAGE
   ELSE LINESTART := SYMCURSOR;
   IF SYMBUFP^[SYMCURSOR] = CHR(12(*FF*)) THEN SYMCURSOR:=SYMCURSOR+1;
   IF SYMBUFP^[SYMCURSOR] = CHR(16(*DLE*)) THEN
     SYMCURSOR := SYMCURSOR+2
   ELSE
     BEGIN
       SYMCURSOR := SYMCURSOR+SCAN(80,<>CHR(9),SYMBUFP^[SYMCURSOR]);
       SYMCURSOR := SYMCURSOR+SCAN(80,<>' ',SYMBUFP^[SYMCURSOR])
     END;
   IF DP THEN LINEINFO := LC ELSE LINEINFO := IC
 END;

 PROCEDURE COMMENTER(STOPPER: CHAR);
   VAR CH,SW,DEL: CHAR; LTITLE: STRING[40];

   PROCEDURE SCANSTRING(VAR STRG: STRING; MAXLENG: INTEGER);
     VAR LENG: INTEGER;
   BEGIN SYMCURSOR := SYMCURSOR+2;
     LENG := SCAN(MAXLENG,=STOPPER,SYMBUFP^[SYMCURSOR]);
     STRG[0] := CHR(LENG);
     MOVELEFT(SYMBUFP^[SYMCURSOR],STRG[1],LENG);
     SYMCURSOR := SYMCURSOR+LENG+1
   END (*SCANSTRING*) ;

 BEGIN
   SYMCURSOR := SYMCURSOR+1; (* POINT TO THE FIRST CH PAST "(*" *)
   IF SYMBUFP^[SYMCURSOR]='$' THEN
      IF SYMBUFP^[SYMCURSOR+1] <> STOPPER THEN
         REPEAT
           CH := SYMBUFP^[SYMCURSOR+1];
           SW := SYMBUFP^[SYMCURSOR+2];
           DEL := SYMBUFP^[SYMCURSOR+3];
           IF (SW = ',') OR (SW = STOPPER) THEN
             BEGIN DEL := SW; SW := '+';
               SYMCURSOR := SYMCURSOR-1
             END;
           CASE CH OF
           'C': BEGIN
                  IF LEVEL > 1 THEN ERROR(194);
                  NEW(COMMENT); SCANSTRING(COMMENT^,80); EXIT(COMMENTER)
                END;
           'D': DEBUGGING := (SW='+');
           'G': GOTOOK := (SW='+');
           'I': IF (SW='+') OR (SW='-') THEN IOCHECK := (SW='+')
                ELSE
                  BEGIN SCANSTRING(LTITLE,40);
                    IF STOPPER = '*' THEN
                      SYMCURSOR := SYMCURSOR+1;
                    IF LIST THEN
                      BEGIN
                        SYMCURSOR := SYMCURSOR + 1;
                        PRINTLINE;
                        SYMCURSOR := SYMCURSOR - 1;
                      END;
                    IF INCLUDING OR INMODULE AND ININTERFACE THEN
                      BEGIN ERROR(406); EXIT(COMMENTER) END;
                    OPENOLD(INCLFILE,LTITLE);
                    IF IORESULT <> 0 THEN
                      BEGIN OPENOLD(INCLFILE,CONCAT(LTITLE,'.TEXT'));
                         IF IORESULT <> 0 THEN ERROR(403)
                      END;
                    INCLUDING := TRUE;
                    OLDSYMCURSOR := SYMCURSOR;
                    OLDLINESTART := LINESTART;
                    OLDSYMBLK := SYMBLK-2;
                    SYMBLK := 2; GETNEXTPAGE;
                    INSYMBOL; EXIT(INSYMBOL)
                  END;
           'L': IF (SW='+') OR (SW='-') THEN
                  BEGIN LIST := (SW='+');
                    IF LIST THEN OPENNEW(LP,'*SYSTEM.LST.TEXT')
                  END
                ELSE
                  BEGIN SCANSTRING(LTITLE,40);
                    OPENNEW(LP,LTITLE);
                    LIST := IORESULT = 0;
                    EXIT(COMMENTER)
                  END;
           'Q': NOISY := (SW='-');
           'P': WRITE(LP,CHR(12(*FF*)));
           'R': RANGECHECK := (SW='+');
           'S': NOSWAP:=(SW='-');
           'T': TINY := (SW='+');
           'U': IF (SW='+') OR (SW='-') THEN
                  BEGIN SYSCOMP := (SW = '-');
                    RANGECHECK := NOT SYSCOMP;
                    IOCHECK := RANGECHECK;
                    GOTOOK := SYSCOMP
                  END
                ELSE
                  IF NOT USING THEN
                    BEGIN SCANSTRING(SYSTEMLIB,40);
                      CLOSE(LIBRARY); LIBNOTOPEN := TRUE;
                      EXIT(COMMENTER)
                    END
           END (*CASES*);
           SYMCURSOR := SYMCURSOR+3;
         UNTIL DEL <> ',';
   SYMCURSOR := SYMCURSOR-1; (* ADJUST *)
   REPEAT
     REPEAT
       SYMCURSOR := SYMCURSOR+1;
       WHILE SYMBUFP^[SYMCURSOR] = CHR(EOL) DO CHECKEND
     UNTIL SYMBUFP^[SYMCURSOR]=STOPPER;
   UNTIL (SYMBUFP^[SYMCURSOR+1]=')') OR (STOPPER='}');
   SYMCURSOR := SYMCURSOR+1;
 END (*COMMENTER*);

 PROCEDURE STRING;
 LABEL 1;
 VAR
   T: PACKED ARRAY [1..80] OF CHAR;
   TP,NBLANKS,L: INTEGER;
   DUPLE: BOOLEAN;

 BEGIN
   DUPLE := FALSE; (* INDICATES WHEN '' IS PRESENT *)
   TP := 0; (* INDEX INTO TEMPORARY STRING *)
   REPEAT
     IF DUPLE THEN SYMCURSOR := SYMCURSOR+1;
     REPEAT
       SYMCURSOR := SYMCURSOR+1;
       TP := TP+1;
       IF SYMBUFP^[SYMCURSOR] = CHR(EOL) THEN
         BEGIN ERROR(202); CHECKEND; GOTO 1 END;
       T[TP] := SYMBUFP^[SYMCURSOR];
     UNTIL SYMBUFP^[SYMCURSOR]='''';
     DUPLE := TRUE;
   UNTIL SYMBUFP^[SYMCURSOR+1]<>'''';
 1:  TP := TP-1; (* ADJUST *)
   SY := STRINGCONST; OP := NOOP;
   LGTH := TP; (* GROSS *)
   IF TP=1 (* SINGLE CHARACTER CONSTANT *)
     THEN
       VAL.IVAL := ORD(T[1])
     ELSE
       WITH SCONST^ DO
         BEGIN
           CCLASS := STRG;
           SLGTH := TP;
           MOVELEFT(T[1],SVAL[1],TP);
           VAL.VALP := SCONST
         END
 END(*STRING*);

 PROCEDURE NUMBER;
 VAR
   EXPONENT,ENDI,ENDF,ENDE,SIGN,IPART,FPART,EPART,
   ISUM:  INTEGER;
   TIPE: (REALTIPE,INTEGERTIPE);
   RSUM: REAL;
   NOTLONG: BOOLEAN;
   K,J: INTEGER;
 BEGIN
   (* TAKES A NUMBER AND DECIDES WHETHER IT'S REAL
      OR INTEGER AND CONVERTS IT TO THE INTERNAL
      FORM. *)
   TIPE := INTEGERTIPE;
   ENDI := 0;
   ENDF := 0;
   ENDE := 0;
   SIGN := 1;
   NOTLONG := TRUE;
   EPART := 9999; (* OUT OF REACH *)
   IPART := SYMCURSOR; (* INTEGER PART STARTS HERE *)
   REPEAT
     SYMCURSOR := SYMCURSOR+1
   UNTIL (SYMBUFP^[SYMCURSOR]<'0') OR (SYMBUFP^[SYMCURSOR]>'9');
   (* SYMCURSOR NOW POINTS AT FIRST CHARACTER PAST INTEGER PART *)
   ENDI := SYMCURSOR-1; (* MARK THE END OF IPART *)
   IF SYMBUFP^[SYMCURSOR]='.'
     THEN
       IF SYMBUFP^[SYMCURSOR+1]<>'.'  (* WATCH OUT FOR '..' *)
         THEN
           BEGIN
             TIPE := REALTIPE;
             SYMCURSOR := SYMCURSOR+1;
             FPART := SYMCURSOR; (* BEGINNING OF FPART *)
             WHILE (SYMBUFP^[SYMCURSOR] >= '0') AND
                   (SYMBUFP^[SYMCURSOR] <= '9') DO
               SYMCURSOR := SYMCURSOR+1;
             IF SYMCURSOR = FPART THEN ERROR(201);
             ENDF := SYMCURSOR-1;
           END;
   IF SYMBUFP^[SYMCURSOR]='E'
     THEN
       BEGIN
         TIPE := REALTIPE;
         SYMCURSOR := SYMCURSOR+1;
         IF SYMBUFP^[SYMCURSOR]='-'
           THEN
             BEGIN
               SYMCURSOR := SYMCURSOR+1;
               SIGN := -1;
             END
           ELSE
             IF SYMBUFP^[SYMCURSOR]='+'
               THEN
                 SYMCURSOR := SYMCURSOR+1;
         EPART := SYMCURSOR; (* BEGINNING OF EXPONENT *)
         WHILE (SYMBUFP^[SYMCURSOR]>='0') AND (SYMBUFP^[SYMCURSOR]<='9') DO
           SYMCURSOR := SYMCURSOR+1;
         ENDE := SYMCURSOR-1;
         IF ENDE<EPART THEN ERROR(201); (* ERROR IN REAL CONSTANT *)
       END;
   (* NOW CONVERT TO INTERNAL FORM *)
   IF TIPE=INTEGERTIPE THEN
     BEGIN
       ISUM := 0;
       FOR J := IPART TO ENDI DO
         BEGIN
           IF (ISUM>MAXINT DIV 10) OR ((ISUM=MAXINT DIV 10) AND
                       (ORD(SYMBUFP^[J]) - ORD('0') > MAXINT MOD 10)) THEN
               BEGIN NOTLONG := FALSE; K := J; J := ENDI END
           ELSE ISUM := ISUM*10+(ORD(SYMBUFP^[J])-ORD('0'));
         END;
         IF NOTLONG THEN
           BEGIN
             SY := INTCONST;  OP := NOOP;
             VAL.IVAL := ISUM;
           END
         ELSE
           BEGIN
             IF ENDI - IPART >= MAXDEC THEN
               BEGIN ERROR(203); IPART := ENDI; K := ENDI END;
             NEW(LVP,LONG);
             WITH LVP^ DO
               BEGIN CCLASS := LONG; J := 4; LLENG := 0;
                 WHILE K <= ENDI DO
                   BEGIN
                     IF J = 4 THEN
                       BEGIN LLENG := LLENG + 1;
                         LONGVAL[LLENG] := ISUM;
                         ISUM := 0;
                         J := 0
                       END;
                     ISUM := ISUM * 10 + ORD(SYMBUFP^[K])-ORD('0');
                     K := K + 1; J := J + 1
                   END;
                 LLAST := J;
                 IF J > 0 THEN
                   BEGIN LLENG := LLENG + 1;
                     LONGVAL[LLENG] := ISUM
                   END;
               END;
             SY := LONGCONST; OP := NOOP;
             LGTH := ENDI - IPART + 1;
             VAL.VALP := LVP
           END;
     END (*TIPE = INTEGERTIPE*)
   ELSE
     BEGIN (* REAL NUMBER HERE *)
       RSUM := 0;
       FOR J := IPART TO ENDI DO
         BEGIN
           RSUM := RSUM*10+(ORD(SYMBUFP^[J])-ORD('0'));
         END;
       FOR J := ENDF DOWNTO FPART DO
         RSUM := RSUM+(ORD(SYMBUFP^[J])-ORD('0'))/PWROFTEN(J-FPART+1);
       EXPONENT := 0;
       FOR J := EPART TO ENDE DO
         EXPONENT := EXPONENT*10+ORD(SYMBUFP^[J])-ORD('0');
       IF SIGN=-1 THEN
         RSUM := RSUM/PWROFTEN(EXPONENT)
       ELSE
         RSUM := RSUM*PWROFTEN(EXPONENT);
       SY := REALCONST;  OP := NOOP;
       NEW(LVP,REEL);
       LVP^.CCLASS := REEL;
       LVP^.RVAL := RSUM;
       VAL.VALP := LVP;
     END;
   SYMCURSOR := SYMCURSOR-1; (* ADJUST FOR POSTERITY *)
 END (*NUMBER*) ;

 BEGIN (* INSYMBOL *)
   IF GETSTMTLEV THEN BEGIN BEGSTMTLEV := STMTLEV; GETSTMTLEV := FALSE END;
   OP := NOOP;
 1:  SY := OTHERSY; (* IF NO CASES EXERCISED BLOW UP *)
   CASE SYMBUFP^[SYMCURSOR] OF
   '''':STRING;
   '0','1','2','3','4','5','6','7','8','9':
        NUMBER;
   'A','B','C','D','E','F','G','H','I','J','K','L','M',
   'N','O','P','Q','R','S','T','U','V','W','X','Y','Z',
   'a','b','c','d','e','f','g','h','i','j','k','l','m',
   'n','o','p','q','r','s','t','u','v','w','x','y','z':
        IDSEARCH(SYMCURSOR,SYMBUFP^); (* MAGIC PROC *)
   '{': BEGIN COMMENTER('}'); GOTO 1 END;
   '(': BEGIN
          IF SYMBUFP^[SYMCURSOR+1]='*' THEN
              BEGIN
                 SYMCURSOR := SYMCURSOR+1;
                 COMMENTER('*');
                 SYMCURSOR := SYMCURSOR+1;
                 GOTO 1; (* GET ANOTHER TOKEN *)
              END
            ELSE
              SY := LPARENT;
        END;
   ')': SY := RPARENT;
   ',': SY := COMMA;
   ' ',' ': BEGIN SYMCURSOR := SYMCURSOR+1; GOTO 1; END;
   '.': BEGIN
          IF SYMBUFP^[SYMCURSOR+1]='.'
            THEN
              BEGIN
                SYMCURSOR := SYMCURSOR+1;
                SY := COLON
              END
            ELSE
              SY := PERIOD;
        END;
   ':': IF SYMBUFP^[SYMCURSOR+1]='='
          THEN
            BEGIN
              SYMCURSOR := SYMCURSOR+1;
              SY := BECOMES;
           END
         ELSE
            SY := COLON;
   ';': SY := SEMICOLON;
   '^': SY := ARROW;
   '[': SY := LBRACK;
   ']': SY := RBRACK;
   '*': BEGIN SY := MULOP; OP := MUL END;
   '+': BEGIN SY := ADDOP; OP := PLUS END;
   '-': BEGIN SY := ADDOP; OP := MINUS END;
   '/': BEGIN SY := MULOP; OP := RDIV END;
   '<': BEGIN
          SY := RELOP;
          OP := LTOP;
          CASE SYMBUFP^[SYMCURSOR+1] OF
            '>': BEGIN
                   OP := NEOP;
                   SYMCURSOR := SYMCURSOR+1
                 END;
            '=': BEGIN
                   OP := LEOP;
                   SYMCURSOR := SYMCURSOR+1
                 END
          END;
        END;
   '=': BEGIN SY := RELOP; OP := EQOP END;
   '>': BEGIN
          SY := RELOP;
          IF SYMBUFP^[SYMCURSOR+1]='='
            THEN
              BEGIN
                OP := GEOP;
                SYMCURSOR := SYMCURSOR+1;
              END
            ELSE
              OP := GTOP;
        END
 END (* CASE SYMBUFP^[SYMCURSOR] OF *);
   IF SY=OTHERSY THEN
     IF SYMBUFP^[SYMCURSOR] = CHR(EOL) THEN
       BEGIN CHECKEND; GETSTMTLEV := TRUE; GOTO 1 END
     ELSE ERROR(400);
   SYMCURSOR := SYMCURSOR+1; (* NEXT CALL TALKS ABOUT NEXT TOKEN *)
 END (*INSYMBOL*) ;

 (* $I PROCS.B.TEXT*)
	
   (*      COPYRIGHT  (C) 1978, REGENTS OF THE      *)
   (*      UNIVERSITY OF CALIFORNIA, SAN DIEGO      *)

   PROCEDURE SEARCHSECTION(*FCP: CTP; VAR FCP1: CTP*);
   BEGIN
     IF FCP <> NIL THEN
       IF TREESEARCH(FCP,FCP1,ID) = 0 THEN (*NADA*)
       ELSE FCP1 := NIL
     ELSE FCP1 := NIL
   END (*SEARCHSECTION*) ;

   PROCEDURE SEARCHID(*FIDCLS: SETOFIDS; VAR FCP: CTP*);
     LABEL 1; VAR LCP: CTP;
   BEGIN
     FOR DISX := TOP DOWNTO 0 DO
       BEGIN LCP := DISPLAY[DISX].FNAME;
         IF LCP <> NIL THEN
           IF TREESEARCH(LCP,LCP,ID) = 0 THEN
             IF LCP^.KLASS IN FIDCLS THEN GOTO 1
             ELSE
               IF PRTERR THEN ERROR(103)
               ELSE LCP := NIL
           ELSE LCP := NIL
       END;
     IF PRTERR THEN
       BEGIN ERROR(104);
         IF TYPES IN FIDCLS THEN LCP := UTYPPTR
         ELSE
           IF ACTUALVARS IN FIDCLS THEN LCP := UVARPTR
           ELSE
             IF FIELD IN FIDCLS THEN LCP := UFLDPTR
             ELSE
               IF KONST IN FIDCLS THEN LCP := UCSTPTR
               ELSE
                 IF PROC IN FIDCLS THEN LCP := UPRCPTR
                 ELSE LCP := UFCTPTR
       END;
 1:  FCP := LCP
   END (*SEARCHID*) ;

   PROCEDURE GETBOUNDS(*FSP: STP; VAR FMIN,FMAX: INTEGER*);
   BEGIN
     WITH FSP^ DO
       IF FORM = SUBRANGE THEN
         BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END
       ELSE
         BEGIN FMIN := 0;
           IF FSP = CHARPTR THEN FMAX := 255
           ELSE
             IF FSP^.FCONST <> NIL THEN
               FMAX := FSP^.FCONST^.VALUES.IVAL
             ELSE FMAX := 0
         END
   END (*GETBOUNDS*) ;

   PROCEDURE SKIP(*FSYS: SETOFSYS*);
   BEGIN WHILE NOT(SY IN FSYS) DO INSYMBOL
   END (*SKIP*) ;

   FUNCTION PAOFCHAR(*FSP: STP): BOOLEAN*);
   BEGIN PAOFCHAR := FALSE;
     IF FSP <> NIL THEN
       IF FSP^.FORM = ARRAYS THEN
         PAOFCHAR := FSP^.AISPACKD AND (FSP^.AELTYPE = CHARPTR)
   END (*PAOFCHAR*) ;

   FUNCTION STRGTYPE(*FSP: STP) : BOOLEAN*);
   BEGIN STRGTYPE := FALSE;
     IF PAOFCHAR(FSP) THEN STRGTYPE := FSP^.AISSTRNG
   END (*STRGTYPE*) ;

   FUNCTION DECSIZE(*I: INTEGER): INTEGER*);
   BEGIN DECSIZE := (TRUNC(I*3.321) + 1 + BITSPERWD) DIV BITSPERWD
   END (*DECSIZE*) ;
   PROCEDURE CONSTANT(*FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU*);
     VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG);
         LVP: CSP;
   BEGIN LSP := NIL; FVALU.IVAL := 0;
     IF NOT(SY IN CONSTBEGSYS) THEN
       BEGIN ERROR(50); SKIP(FSYS+CONSTBEGSYS) END;
     IF SY IN CONSTBEGSYS THEN
       BEGIN
         IF SY = STRINGCONSTSY THEN
           BEGIN
             IF LGTH = 1 THEN LSP := CHARPTR
             ELSE
               BEGIN
                 NEW(LSP,ARRAYS,TRUE,TRUE);
                 LSP^ := STRGPTR^;
                 LSP^.MAXLENG := LGTH;
                 LSP^.INXTYPE := NIL;
                 NEW(LVP);
                 LVP^ := VAL.VALP^;
                 VAL.VALP := LVP
               END;
             FVALU := VAL; INSYMBOL
           END
         ELSE
           BEGIN
             SIGN := NONE;
             IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN
               BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG;
                 INSYMBOL
               END;
             IF SY = IDENT THEN
               BEGIN SEARCHID([KONST],LCP);
                 WITH LCP^ DO
                   BEGIN LSP := IDTYPE; FVALU := VALUES END;
                 IF SIGN <> NONE THEN
                   IF LSP = INTPTR THEN
                     BEGIN IF SIGN = NEG THEN
                       FVALU.IVAL := -FVALU.IVAL END
                   ELSE
                     IF LSP = REALPTR THEN
                       BEGIN
                         IF SIGN = NEG THEN
                           BEGIN NEW(LVP,REEL);
                             LVP^.CCLASS := REEL;
                             LVP^.RVAL := -FVALU.VALP^.RVAL;
                             FVALU.VALP := LVP;
                           END
                       END
                     ELSE
                       IF COMPTYPES(LSP,LONGINTPTR) THEN
                         BEGIN
                           IF SIGN = NEG THEN
                             BEGIN NEW(LVP,LONG);
                               LVP^.CCLASS := LONG;
                               LVP^.LONGVAL[1] := - FVALU.VALP^.LONGVAL[1];
                               FVALU.VALP := LVP
                             END
                         END
                       ELSE ERROR(105);
                 INSYMBOL;
               END
             ELSE
               IF SY = INTCONST THEN
                 BEGIN IF SIGN = NEG THEN VAL.IVAL := -VAL.IVAL;
                   LSP := INTPTR; FVALU := VAL; INSYMBOL
                 END
               ELSE
                 IF SY = REALCONST THEN
                   BEGIN IF SIGN = NEG THEN
                           VAL.VALP^.RVAL := -VAL.VALP^.RVAL;
                     LSP := REALPTR; FVALU := VAL; INSYMBOL
                   END
                 ELSE
                   IF SY = LONGCONST THEN
                     BEGIN
                       IF SIGN = NEG THEN
                         BEGIN VAL.VALP^.LONGVAL[1] := - VAL.VALP^.LONGVAL[1];
                           NEW(LSP,LONGINT);
                           LSP^.SIZE := DECSIZE(LGTH);
                           LSP^.FORM := LONGINT;
                           FVALU := VAL;
                           INSYMBOL
                         END
                     END
                   ELSE
                     BEGIN ERROR(106); SKIP(FSYS) END
           END;
         IF NOT (SY IN FSYS) THEN
           BEGIN ERROR(6); SKIP(FSYS) END
         END;
     FSP := LSP
   END (*CONSTANT*) ;

   FUNCTION COMPTYPES(*FSP1,FSP2: STP) : BOOLEAN*);
     VAR NXT1,NXT2: CTP; COMP: BOOLEAN;
       LTESTP1,LTESTP2 : TESTP;
   BEGIN
     IF FSP1 = FSP2 THEN COMPTYPES := TRUE
     ELSE
       IF (FSP1 = NIL) OR (FSP2 = NIL) THEN COMPTYPES := TRUE
       ELSE
         IF FSP1^.FORM = FSP2^.FORM THEN
           CASE FSP1^.FORM OF
             SCALAR:
               COMPTYPES := FALSE;
             SUBRANGE:
               COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,
                                        FSP2^.RANGETYPE);
             POINTER:
                 BEGIN
                   COMP := FALSE; LTESTP1 := GLOBTESTP;
                   LTESTP2 := GLOBTESTP;
                   WHILE LTESTP1 <> NIL DO
                     WITH LTESTP1^ DO
                       BEGIN
                         IF (ELT1 = FSP1^.ELTYPE) AND
                           (ELT2 = FSP2^.ELTYPE) THEN COMP := TRUE;
                         LTESTP1 := LASTTESTP
                       END;
                   IF NOT COMP THEN
                     BEGIN NEW(LTESTP1);
                       WITH LTESTP1^ DO
                         BEGIN ELT1 := FSP1^.ELTYPE;
                           ELT2 := FSP2^.ELTYPE;
                           LASTTESTP := GLOBTESTP
                         END;
                       GLOBTESTP := LTESTP1;
                       COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE)
                     END;
                   COMPTYPES := COMP; GLOBTESTP := LTESTP2
                 END;
             LONGINT: COMPTYPES := TRUE;
             POWER:
               COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET);
             ARRAYS:
               BEGIN
                 COMP := COMPTYPES(FSP1^.AELTYPE,FSP2^.AELTYPE)
                         AND (FSP1^.AISPACKD = FSP2^.AISPACKD);
                 IF COMP AND FSP1^.AISPACKD THEN
                     COMP := (FSP1^.ELSPERWD = FSP2^.ELSPERWD)
                             AND (FSP1^.ELWIDTH = FSP2^.ELWIDTH)
                             AND (FSP1^.AISSTRNG = FSP2^.AISSTRNG);
                 IF COMP AND NOT STRGTYPE(FSP1) THEN
                   COMP := (FSP1^.SIZE = FSP2^.SIZE);
                 COMPTYPES := COMP;
               END;
             RECORDS:
               BEGIN NXT1 := FSP1^.FSTFLD; NXT2 := FSP2^.FSTFLD;
                 COMP := TRUE;
                 WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) AND COMP DO
                   BEGIN COMP:=COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE);
                     NXT1 := NXT1^.NEXT; NXT2 := NXT2^.NEXT
                   END;
                 COMPTYPES := COMP AND (NXT1 = NIL) AND (NXT2 = NIL)
                             AND (FSP1^.RECVAR = NIL)
                             AND (FSP2^.RECVAR = NIL)
               END;
             FILES:
               COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE)
           END (*CASE*)
         ELSE (*FSP1^.FORM <> FSP2^.FORM*)
           IF FSP1^.FORM = SUBRANGE THEN
             COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2)
           ELSE
             IF FSP2^.FORM = SUBRANGE THEN
               COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE)
             ELSE COMPTYPES := FALSE
   END (*COMPTYPES*) ;


   PROCEDURE GENBYTE(*FBYTE: INTEGER*);
   BEGIN
     CODEP^[IC] := CHR(FBYTE); IC := IC+1
   END (*GENBYTE*) ;

   PROCEDURE GENWORD(*FWORD: INTEGER*);
   BEGIN
     IF ODD(IC) THEN IC := IC + 1;
     MOVELEFT(FWORD,CODEP^[IC],2);
     IC := IC + 2
   END (*GENWORD*) ;

 PROCEDURE WRITETEXT;
   BEGIN
     MOVELEFT(SYMBUFP^[SYMCURSOR],CODEP^[0],1024);
     IF USERINFO.ERRNUM = 0 THEN
       IF BLOCKWRITE(USERINFO.WORKCODE^,CODEP^[0],2,CURBLK) <> 2 THEN
         ERROR(402);
     CURBLK := CURBLK + 2
   END (*WRITETEXT*) ;

   PROCEDURE WRITECODE(*FORCEBUF: BOOLEAN*);
     VAR CODEINX,LIC,I: INTEGER;
   BEGIN CODEINX := 0; LIC := IC;
     REPEAT
       I := 512-CURBYTE;
       IF I > LIC THEN I := LIC;
       MOVELEFT(CODEP^[CODEINX],DISKBUF[CURBYTE],I);
       CODEINX := CODEINX+I;
       CURBYTE := CURBYTE+I;
       IF (CURBYTE = 512) OR FORCEBUF THEN
         BEGIN
           IF USERINFO.ERRNUM = 0 THEN
             IF BLOCKWRITE(USERINFO.WORKCODE^,DISKBUF,1,CURBLK) <> 1 THEN
               ERROR(402);
           CURBLK := CURBLK+1; CURBYTE := 0
         END;
       LIC := LIC-I
     UNTIL LIC = 0;
   END (*WRITECODE*) ;

   PROCEDURE FINISHSEG;
     VAR I: INTEGER;
   BEGIN IC := 0;
     FOR I := NEXTPROC-1 DOWNTO 1 DO
       IF PROCTABLE[I] = 0 THEN
         GENWORD(0)
       ELSE
         GENWORD(SEGINX+IC-PROCTABLE[I]);
     GENBYTE(SEG); GENBYTE(NEXTPROC-1);
     SEGTABLE[SEG].CODELENG := SEGINX+IC;
     WRITECODE(TRUE); SEGINX := 0; CODEINSEG := FALSE
   END (*FINISHSEG*) ;

 (* $I BLOCK.TEXT*)

 PROCEDURE BLOCK(*FSYS: SETOFSYS*);
 LABEL 1;
 VAR BFSYFOUND: BOOLEAN;

   PROCEDURE FINDFORW(FCP: CTP);
     BEGIN
       IF FCP <> NIL THEN
         WITH FCP^ DO
           BEGIN
             IF KLASS IN [PROC,FUNC] THEN
               IF PFDECKIND = DECLARED THEN
                 IF PFKIND = ACTUAL THEN
                   IF FORWDECL THEN
                     BEGIN
                       USERINFO.ERRNUM := 117; WRITELN(OUTPUT);
                       WRITE(OUTPUT,NAME,' undefined')
                     END;
             FINDFORW(RLINK); FINDFORW(LLINK)
           END
     END (*FINDFORW*) ;

   BEGIN (*BLOCK*)
      IF (NOSWAP) AND (STARTINGUP) THEN
        BEGIN
          BODYPART(FSYS,NIL);
          EXIT(BLOCK);
        END;
      IF (SY IN [UNITSY,SEPARATSY]) AND (NOT INMODULE) THEN
        BEGIN
          UNITPART(FSYS + [UNITSY,INTERSY,IMPLESY,ENDSY]);
          IF SY = PERIOD THEN EXIT(BLOCK)
        END;
      NEWBLOCK:=TRUE;
      REPEAT
        IF NOT NEWBLOCK THEN
          BEGIN
            DP := FALSE; STMTLEV := 0; IC := 0; LINEINFO := 0;
            IF (NOT SYSCOMP) OR (LEVEL>1) THEN FINDFORW(DISPLAY[TOP].FNAME);
            IF INMODULE THEN
              IF TOS^.PREVLEXSTACKP^.DFPROCP = OUTERBLOCK THEN
                IF (SY = ENDSY) THEN
                  BEGIN FINISHSEG; EXIT(BLOCK) END
                ELSE IF (SY = BEGINSY) THEN
                  BEGIN ERROR(13); FINISHSEG; EXIT(BLOCK) END;
            IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17);
            REPEAT
              BODYPART(FSYS + [CASESY] - [ENDSY], TOS^.DFPROCP);
              BFSYFOUND := (SY = TOS^.BFSY) OR (INMODULE AND (SY = ENDSY));
              IF NOT BFSYFOUND THEN
                BEGIN
                  IF TOS^.BFSY = SEMICOLON THEN
                    ERROR(14)  (*SEMICOLON EXPECTED*)
                  ELSE  ERROR(6);  (* PERIOD EXPECTED *)
                  SKIP(FSYS + [TOS^.BFSY]);
                  BFSYFOUND := (SY = TOS^.BFSY) OR (INMODULE AND (SY = ENDSY))
              END
            UNTIL (BFSYFOUND) OR (SY IN BLOCKBEGSYS);
            IF NOT BFSYFOUND THEN
              BEGIN
                IF TOS^.BFSY = SEMICOLON THEN ERROR(14)
                ELSE ERROR(6); (*PERIOD EXPECTED*)
                DECLARATIONPART(FSYS);
              END
            ELSE
              BEGIN
                IF SY = SEMICOLON THEN INSYMBOL;
                IF (NOT(SY IN [BEGINSY,PROCSY,FUNCSY,PROGSY])) AND
                   (TOS^.BFSY = SEMICOLON) THEN
                  IF NOT (INMODULE AND (SY = ENDSY)) THEN
                    BEGIN
                      ERROR(6); SKIP(FSYS);
                      DECLARATIONPART(FSYS);
                    END
                  ELSE GOTO 1
                ELSE
          1:      BEGIN
                    WITH TOS^ DO
                      BEGIN
                        IF DFPROCP <> NIL THEN
                          DFPROCP^.INSCOPE:=FALSE;
                        IF ISSEGMENT THEN
                          BEGIN
                            IF CODEINSEG THEN FINISHSEG;
                            IF DLINKERINFO AND (LEVEL = 1) THEN
                              BEGIN SEGTABLE[SEG].SEGKIND := 2;
                                WRITELINKERINFO(TRUE)
                              END
                            ELSE
                              IF CLINKERINFO THEN
                                BEGIN SEGTABLE[SEG].SEGKIND := 2;
                                  WRITELINKERINFO(FALSE)
                                END;
                            NEXTPROC:=SOLDPROC;
                            SEG:=DOLDSEG;
                          END;
                        LEVEL:=DOLDLEV;
                        TOP:=DOLDTOP;
                        LC:=DLLC;
                        CURPROC:=POLDPROC;
                      END;
                    RELEASE(TOS^.DMARKP);
                    TOS:=TOS^.PREVLEXSTACKP;
                    NEWBLOCK:=(SY IN [PROCSY,FUNCSY,PROGSY]);
                  END
              END
          END
        ELSE
          BEGIN DECLARATIONPART(FSYS);
            IF LEVEL = 0 THEN
              IF SY IN [UNITSY,SEPARATSY] THEN
                BEGIN
                  UNITPART(FSYS + [UNITSY,INTERSY,IMPLESY,ENDSY]);
                  IF SY IN [PROCSY,FUNCSY,PROGSY] THEN DECLARATIONPART(FSYS)
                END
          END;
      UNTIL TOS = NIL;
      FINISHSEG;
  END (*BLOCK*) ;

 BEGIN (* PASCALCOMPILER *)
   COMPINIT;
   TIME(LGTH,LOWTIME);
   BLOCK(BLOCKBEGSYS+STATBEGSYS-[CASESY]);
   IF SY <> PERIOD THEN ERROR(21);
   IF LIST THEN
     BEGIN SCREENDOTS := SCREENDOTS+1;
       SYMBUFP^[SYMCURSOR] := CHR(EOL);
       SYMCURSOR := SYMCURSOR+1;
       PRINTLINE
     END;
   USERINFO.ERRBLK := 0;
   TIME(LGTH,STARTDOTS); LOWTIME := STARTDOTS-LOWTIME;
   UNITWRITE(3,IC,7);
   IF DLINKERINFO OR CLINKERINFO THEN
     BEGIN SEGTABLE[SEG].SEGKIND := 1;
       WRITELINKERINFO(TRUE)
     END;
   CLOSE(LP,LOCK);
   IF NOISY THEN WRITELN(OUTPUT);
   WRITE(OUTPUT,SCREENDOTS,' lines');
   IF LOWTIME > 0 THEN
     WRITE(OUTPUT,', ',(LOWTIME+30) DIV 60,' secs, ',
         ROUND((3600/LOWTIME)*SCREENDOTS),' lines/min');
   IF NOISY THEN
     BEGIN
       WRITELN(OUTPUT);
       WRITE(OUTPUT,'Smallest available space = ',SMALLESTSPACE,' words');
     END;
   IC := 0;
   FOR SEG := 0 TO MAXSEG DO
     WITH SEGTABLE[SEG] DO
       BEGIN GENWORD(DISKADDR); GENWORD(CODELENG) END;
   FOR SEG := 0 TO MAXSEG DO
     WITH SEGTABLE[SEG] DO
       FOR LGTH := 1 TO 8 DO
         GENBYTE(ORD(SEGNAME[LGTH]));
   FOR SEG := 0 TO MAXSEG DO GENWORD(SEGTABLE[SEG].SEGKIND);
   FOR SEG := 0 TO MAXSEG DO GENWORD(SEGTABLE[SEG].TEXTADDR);
   FOR LGTH := 1 TO 80 DO
     IF COMMENT <> NIL THEN GENBYTE(ORD(COMMENT^[LGTH])) ELSE GENBYTE(0);
   FOR LGTH := 1 TO 256 - 8*(MAXSEG + 1) - 40 DO GENWORD(0);
   CURBLK := 0; CURBYTE := 0; WRITECODE(TRUE)
 END (* PASCALCOMPILER *) ;

 BEGIN (* SYSTEM *)
 END.
	
{ +------------------------------------------------------------------+
  |                                                                  |
		|                     F     I     N     I     S                    |
		|                                                                  |
		+------------------------------------------------------------------+ }
